Howdy, Stranger!

It looks like you're new here. If you want to get involved, click one of these buttons!

Sign In with Facebook Sign In with Google Sign In with OpenID

Categories

We have migrated to a new platform! Please note that you will need to reset your password to log in (your credentials are still in-tact though). Please contact lee@programmersheaven.com if you have questions.
Welcome to the new platform of Programmer's Heaven! We apologize for the inconvenience caused, if you visited us from a broken link of the previous version. The main reason to move to a new platform is to provide more effective and collaborative experience to you all. Please feel free to experience the new platform and use its exciting features. Contact us for any issue that you need to get clarified. We are more than happy to help you.

Help VBA for EXCEL

scorpioncrscorpioncr Posts: 16Member
Hello.
This is the code so far:

Global GrNom4 As Single
Sub Init()
GrNom4 = InputBox("nnnnnnn&mmmmmmmm XX:")

Sub GetSWDataCom14()
Dim RowPtr As Long, Chan As Long, F1 As Variant, WData As String, i As Integer
RowPtr = ThisWorkbook.Sheets("Sheet1").Cells(3000, 1).End(xlUp).Row + 1
Chan = DDEInitiate("software", "Com14")
F1 = DDERequest(Chan, "Field(1)")
WData = F1(1)
ThisWorkbook.Sheets("Sheet1").Cells(RowPtr, 1).Formula = WData
If WData < 0.5 * GrNom4 or WData > 1.5 * GrNom4 Then
ThisWorkbook.Sheets("Sheet1").Cells(RowPtr, 1).Value = ""
End If
i = RowPtr Mod 31
If i = 0 Then
ThisWorkbook.Sheets("Sheet1").Cells(RowPtr, 1).Formula = "....................."
ThisWorkbook.Sheets("Sheet1").Cells(RowPtr, 2).Value = Time
End If
DDETerminate Chan
End Sub

What the code does: i start the macro, insert one value say 10 and the macro introduces it in column A cel by cell unless the received value is below 50% or above 150% of 10. The values are received from balances.

What i want:
1.[b]If WData < 0.5 * GrNom4 or WData > 1.5 * GrNom4 Then[/b] - this is ok but i needed it to skip a value...say 50. So everything below 50% or above 150% from the original value should not be entered in a cell, except for the "50" value.
2. A column can have a maximum of 3000 values (it can also have 200).... i want to select 30 random values and calculate their average, and then calculate a formula. Something like AAA * 0.603 - this average = XX.

This is not my code. I am not this good.
Any help would be greatly appreciated.
Thank you!
«13

Comments

  • DaiMitnickDaiMitnick Posts: 77Member
    [color=Green]1.If WData < 0.5 * GrNom4 or WData > 1.5 * GrNom4 Then - this is ok but i needed it to skip a value...say 50. So everything below 50% or above 150% from the original value should not be entered in a cell, except for the "50" value.[/color]

    That's easy enough, just add another if statement, so change this:

    [code]
    If WData < 0.5 * GrNom4 or WData > 1.5 * GrNom4 Then
    ThisWorkbook.Sheets("Sheet1").Cells(RowPtr, 1).Value = ""
    End If
    [/code]

    To this:

    [code]
    Const ExceptionValue as String = "50"
    If WData < 0.5 * GrNom4 or WData > 1.5 * GrNom4 Then
    If WData <> ExceptionValue Then
    ThisWorkbook.Sheets("Sheet1").Cells(RowPtr, 1).Value = ""
    End If
    End If
    [/code]

    Or this:

    [code]
    If (WData < 0.5 * GrNom4 or WData > 1.5 * GrNom4) And WData <> 50 Then ThisWorkbook.Sheets("Sheet1").Cells(RowPtr, 1).Value = ""
    [/code]

    Note, that last one is all on one line, you do not need an end if block if you keep the statement all on one line.


    [color=Green]2. A column can have a maximum of 3000 values (it can also have 200).... i want to select 30 random values and calculate their average, and then calculate a formula. Something like AAA * 0.603 - this average = XX. [/color]

    I would build a function for this, something like below:

    [code]
    Public Function GetAverages(ByVal WhichSheet As Worksheet, ByVal WhichCol As Integer) As Double()
    Const NumberOfValues As Integer = 30
    Const HasHeaderRow As Boolean = True 'If the first row has text in it, set to true
    Dim iRow As Integer, GetRow As Integer
    Dim AvNum As Double, LowestNum As Double, HighestNum As Double, iNum As Double
    iRow = 0
    Do
    iRow = iRow + 1
    Loop Until WhichSheet.Cells(iRow + 1, WhichCol).Value = ""
    If HasHeaderRow = True Then iRow = iRow - 1

    AvNum = 0
    LowestNum = 99999
    HighestNum = 0

    For i = 1 To NumberOfValues
    GetRow = Round(Rnd() * iRow, 0)
    If HasHeaderRow = True Then GetRow = GetRow + 1
    iNum = WhichSheet.Cells(GetRow, WhichCol).Value
    If iNum < LowestNum Then LowestNum = iNum
    If iNum > HighestNum Then HighestNum = iNum
    AvNum = AvNum + iNum
    Next
    AvNum = AvNum / NumberOfValues

    Dim TheData() As Double
    ReDim TheData(3)
    TheData(0) = AvNum 'Returns average
    TheData(1) = NumberOfValues 'Returns number of values used
    TheData(2) = LowestNum 'Returns lowest number in range
    TheData(3) = HighestNum 'Returns highest number in range

    GetAverages = TheData
    End Function
    [/code]

    You can then just call this function to retrieve your values, you can even add more values to the output of the function to make it more useful. You will probably want to input the values into cells, but to display how it works, you could call it with the below code:

    [code]
    Sub DisplayAverages()
    Dim TheSheet As Worksheet, sStr As String
    Set TheSheet = ActiveWorkbook.Sheets("Sheet1")
    Dim avValues() As Double
    avValues = GetAverages(TheSheet, 1)
    sStr = "An average of " & avValues(0) & " was found by analysing " & avValues(1)
    sStr = sStr & " values, ranging from " & avValues(2) & " to " & avValues(3)
    MsgBox sStr
    End Sub
    [/code]

    In this example you will need to have values in column A of Sheet1.

    HTH, Dai

    ------------------------------------------
    Do or do not, there is no try. |
    ------------------------------------------
  • scorpioncrscorpioncr Posts: 16Member
    HELLO & THANK YOU!

    The first bit works like a charm. I especially liked the one line code. Very clean ... you sir know your stuff.
    The second part i didn't get the chance to test, yet. I will do so ASAP.

    And i have another question:

    How to make "50" appear on the worksheet in the same number cell on column 6 as the last number from column 5.
    Basically whenever "50" appears, it's placed next to the last occupied cell on column 5, but on column 6.
    I hope i made myself clear, my English is a bit rusty.

    Again thank you very much for the help so far.

    Have a pleasant day,
    scorpi


  • DaiMitnickDaiMitnick Posts: 77Member
    Not 100% sure I understand what you need, but my guess is that going down column E you have some blank values and/or zeros, you wish to ignore these and only put a 50 by the last real number when a 50 is found, so if going down column E you had the values:
    23, 44, 50, 67, 0, 0, 50, 55, ""(blank), 50, 616

    You would want 50s to appear in Column F along side the 44, 67 and 55.

    If that is correct then the below code will achieve what you want. If it is not, please reply back with another explanation of what you're looking for.

    [code]
    Sub Write50s()
    Dim iRo As Integer, NumRows As Integer, LastOcc As Integer
    Dim TheSht As Worksheet
    Set TheSht = Sheets("Sheet1")
    NumRows = TheSht.Cells(3000, 5).End(xlUp).Row
    LastOcc = 1
    TheSht.Columns(6).ClearContents 'Clears column F before starting
    For iRo = 1 To NumRows
    'If Column E has a 50, last occupied cell gets a 50 in Column F
    If TheSht.Cells(iRo, 5).Value = 50 Then TheSht.Cells(LastOcc, 6).Value = 50

    'If Column E isn't blank and isn't a zero, becomes last occupied cell
    If TheSht.Cells(iRo, 5).Value <> "" And TheSht.Cells(iRo, 5).Value <> 0 Then LastOcc = iRo
    Next
    End Sub
    [/code]

    HTH, Dai


    ------------------------------------------
    Do or do not, there is no try. |
    ------------------------------------------
  • scorpioncrscorpioncr Posts: 16Member
    Hi,

    I will try to explain better.
    As you saw in the code, it eliminates anything above 150% or below 50% (because they are considered aberrations).
    All values are with 2 decimals like "31.26". When i launch the macro it asks for the number: let's say 30. The majority of values will be between 29-31 but there is a list of possible values (say from 29.26 - 30.98). Anything below or above is wrong.
    This macro is for a balance and a lot of types of products. The weighing process is automatic but supervised by a human operator (in order to decide if the weight is correct).
    Due to the fact that we have some 200 products to weigh there is no point in making a code for every one (the products may even change from one day to another). So i want to allow the human operator to decide which value is ok.
    And that excepted value will be some type of 50 grams weight (or another value that does not interfere with the product weight).
    So if the maximum value is 30.98 and the current product weighs 31.01 than the human operator weighs that excepted value next ; which appears beside the 31.01 value. Same cell number but next column. So now everybody knows that 31.01 is wrong (he/she does not need to know the exact interval only what 50 means). Of course that "50" value (in excel) can be replaced with a text that says "WRONG VALUE" or something.

    Am i making any sense?

    Thank you very much for trying to help me!

    Have a good day!
    scorpi

  • SundayForeverSundayForever Posts: 4Member
    This post has been deleted.
  • DaiMitnickDaiMitnick Posts: 77Member
    Sorry I haven't replied, do not tend to check over the weekend.

    OK, I think I now know what you mean, I was a bit thrown because I thought you were only looking to do this to randomly selected numbers, but if you are looking to do it to the whole data, I'm thinking you would need to use something like the following:

    [code]
    Global GrNom4 As Single

    Sub Write50s()
    Dim iRo As Integer, NumRows As Integer, MaxValue As Double, MinValue As Double, OrigValue As Double
    Dim Msg50 As String
    Dim TheSht As Worksheet
    Set TheSht = Sheets("Sheet1")
    NumRows = TheSht.Cells(3000, 5).End(xlUp).Row
    Msg50 = "Err 50: Invalid Value"
    GrNom4 = InputBox("nnnnnnn&mmmmmmmm XX:")
    MaxValue = 1.5 * GrNom4
    MinValue = 0.5 * GrNom4

    TheSht.Columns(6).ClearContents 'Clears column F before starting
    For iRo = 1 To NumRows
    'If Column E has a value greater than the maximum allowed...
    If TheSht.Cells(iRo, 5).Value > MaxValue Then TheSht.Cells(iRo, 6).Value = Msg50 & " (too high)"

    'If Column E has a value smaller than the minimum allowed...
    If TheSht.Cells(iRo, 5).Value < MinValue Then TheSht.Cells(iRo, 6).Value = Msg50 & " (too low)"

    Next
    End Sub
    [/code]

    This is based on columns E and F again, if you wish to put the "50" code in column A, change the 6s to 1s. Hope this really does do what you need, if not, just ask again, maybe cite some more examples, We WILL get there! Regards, Dai


    ------------------------------------------
    Do or do not, there is no try. |
    ------------------------------------------
  • scorpioncrscorpioncr Posts: 16Member
    Hi,

    So this is the macro so far:

    Global GrNom4 As Single
    Sub Init()
    GrNom4 = InputBox("Weight T4:")
    On Error Resume Next
    Application.Wait Now + TimeValue("00:00:05")
    Shell ("C:Program Filessoftwaresoftware.exe C:Program FilessoftwarePortBoxCom14.xyz")
    End Sub

    Sub GetSWDataCom14()
    Dim RowPtr As Long, Chan As Long, F1 As Variant, WData As String, i As Integer
    RowPtr = ThisWorkbook.Sheets("Sheet1").Cells(3000, 1).End(xlUp).Row + 1
    Chan = DDEInitiate("WinWedge", "Com14")
    F1 = DDERequest(Chan, "Field(1)")
    WData = F1(1)
    ThisWorkbook.Sheets("Sheet1").Cells(RowPtr, 1).Formula = WData
    If (WData < 0.75 * GrNom4 Or WData > 1.75 * GrNom4) And WData <> 23 Then ThisWorkbook.Sheets("Sheet1").Cells(RowPtr, 1).Value = ""
    i = RowPtr Mod 31
    If i = 0 Then
    ThisWorkbook.Sheets("Sheet1").Cells(RowPtr, 1).Formula = "=AVERAGE(R[-29]C:R[-1]C)"
    ThisWorkbook.Sheets("Sheet1").Cells(RowPtr, 2).Value = Time
    End If
    DDETerminate Chan
    End Sub

    I don't need another input box on column 2. It should be linked to this macro and the values it inputs on column 1.
    I'll try to build an example. Let's say the "good" values are from 30.20 up to 30.25.
    So in the end it looks like this:
    Column A Column B
    30.21
    30.25
    30.22
    30.25
    30.22
    30.21
    30.27 23
    30.22
    30.28 23
    30.21
    30.22
    and so on

    But only the human operator decides 30.27 & 30.28 are wrong. He/she sees the values and the next thing he/she weighs is the excepted value (in this case 23). Once 23 has been weighed the macro "knows" to put this value besides the last input value. So the 23 signals bad value. Next value that is not 23 goes in the cell below and so on.
    This "placing 23 in the adjacent cell" bit needs, if possible, to be inside the already made macro. Not a new macro.
    This bit helps me keep track of how many products not ok. Quality assurance stuff.
    PS: i know that on column 2 a time stamp appears... but it shouldn't be a problem because it's linked to that formula on column 1.

    Thank you again for taking the time to help me!



  • DaiMitnickDaiMitnick Posts: 77Member
    OK I think I'm getting a clearer picture now, so the GetSWDataCom14 sub gets called each time something is weighed correct? And WData is the actual weight being pulled from the Com14 program.

    So if the weight is below 75% of the initial inputbox value (i.e. GrNom4) or above 175% (or 50 and 150, whatever) then you delete the value completely as if it had never been weighed?

    Then if they weigh something that's within these bounds (75% - 175%), but looks too high for the operator, e.g. 30.27, the operator will then weigh a 23 gram weight on the scale as a way of informing the computer that the last value was too high or low, correct?

    If yes to all 3 above, then all you need to do is change the following code:

    [code]
    ThisWorkbook.Sheets("Sheet1").Cells(RowPtr, 1).Formula = WData
    If (WData < 0.75 * GrNom4 Or WData > 1.75 * GrNom4) And WData <> 23 Then ThisWorkbook.Sheets("Sheet1").Cells(RowPtr, 1).Value = ""
    [/code]

    To this:

    [code]
    ThisWorkbook.Sheets("Sheet1").Cells(RowPtr, 1).Formula = WData
    If WData = 23 Then ThisWorkbook.Sheets("Sheet1").Cells(RowPtr -1, 2).Value = 23
    If WData < 0.75 * GrNom4 Or WData > 1.75 * GrNom4 Or WData = 23 Then ThisWorkbook.Sheets("Sheet1").Cells(RowPtr, 1).Value = ""
    [/code]

    My only worry is that you are overwriting the weight with the average formula every 31 rows, are you sure you want to overwrite it, not put it somewhere else?

    Just thinking if you get say a 30.28, on the 31st row, or 62nd etc, then you won't even know about it as it'll just be overwritten with a formula for the averages. You could simply put it on the next line instead so nothing is overwritten?

    Also, I'd recommend working out the average in the code itself, then insert the value into the cell rather than a formula, helps speed up Excel if you use less formulae, may not be noticeable on a small workbook, but as it grows you may find it slow down a little.

    Anyway I hope I have given what you need, if not, please do ask, that's what I'm here for, to answer the sort of questions I was asking everyone else 5+ years ago.

    Regards, Dai


    ------------------------------------------
    Do or do not, there is no try. |
    ------------------------------------------
  • scorpioncrscorpioncr Posts: 16Member
    Hi,

    And it's exactly what i was looking for....thank you!
    The weird thing is that some values seem to "escape" the cleansing (that If WData < 0.75 * GrNom4 Or WData > 1.75 * GrNom4). And it did not happen before. And some values, although collected, do not appear in the cells. Since the macro runs for some 10 balances simultaneously i'm thinking it's too much for the PC or Excel to handle. Any clues?
    I am now trying the bit with the 30 random values... it's going to take some time to test it...i will try not to bother you unless really necessary.

    Take care!
    scorpi


  • DaiMitnickDaiMitnick Posts: 77Member
    How do you mean simultaneously? Separate scales are all feeding into the same workbook at the same time are they?

    As you are finding some aberrations (outside the 50-150%) are slipping through and some normal values are being deleted, it would seem likely that this simultaneous running is causing it to delete at the wrong time(or place). What way are you getting these 10 simultaneous balances? (Does the macro pull through 10 values each time, or are you calling the macro 10 times?) Regards, D


    ------------------------------------------
    Do or do not, there is no try. |
    ------------------------------------------
«13
Sign In or Register to comment.