Search code examples
arraysexcelvbacompareexcel-2010

Excel VBA compare values on multiple rows and execute additional code


I have the following task: There are fields in my document, the combination of which needs to be compared, and if they are the same, another field on the same rows need to be updated.

So far, I add the values in arrays (skipping the first row as header, thus iNum = 2) with select statements per column and concatenate them per row for the comparison.

Dim conc As Range                               'Concatenated fields
Dim iconc() As Variant

ReDim iconc(UBound(iMatn) - 1, 1)

For iNum = 2 To UBound(iMatn)
                
    iconc(iNum - 1, 1) = iMatn(iNum, 1) & iVendr(iNum, 1) & iInd1(iNum, 1) & iInd2(iNum, 1)    'Current concatenation

    Select Case iNum - 1
    
    Case 2:                     'Compare two records
    
        If iconc(iNum - 2, 1) = iconc(iNum - 1, 1) Then         'Compare first and second records
            'Execute code to update the two fields from Extra field column
        End If

    Case 3:                     'Compare three records
    
        If AllSame(iconc(iNum - 3, 1), iconc(iNum - 2, 1), iconc(iNum - 1, 1)) Then
            'Execute code to update the three fields from Extra field column
        End If

I go through each value of the concatenation and compare if its the same as the previous ones with Case statement (I don't expect more than 4 or 5 to be the same, even though there could be a couple hundred of lines). Thus I face two issues:

  1. If there are 3 equal values, for example, the code first jumps to the case for 2. How can I make it so that it skips to the maximum value?
  2. It needs to resume checking after the rows that were already checked. E.g. if the first two are the same, the code should start checking from the third one; basically to start at from the line after the last of any duplicate ones that are located.

Example

Image: the code needs to return that there are 3 equal rows (lines 2 to 4), update the respective cells on the "Extra field" column, proceed further (from line 5), return that there are 2 equal rows (lines 6 and 7), update the same as above again, proceed further (from line 8) etc.

Any help will be highly appreciated as I am stuck with this problem.

Thank you all.


Solution

  • To determine how many are in each group, in order to decide how you will update the extra fields column, I would use a Dictionary & Collection object.

    eg:

    'Set reference to Microsoft Scripting Runtime
    '    (or use late-binding)
    
    Option Explicit
    
    Sub due()
      Dim myDict As Dictionary, col As Collection
      Dim i As Long, v As Variant
      Dim sKey As String
      Dim rTable As Range
      Dim vTable As Variant, vResults As Variant
    
    'there are more robust methods of selecting the table range
    'depending on your actual layout
    'And code will also make a difference if the original range includes
    '  or does not include the "Extra Field" Column
    ' Code below assumes it is NOT included in original data
    
    Set rTable = ThisWorkbook.Worksheets("sheet2").Cells(1, 1).CurrentRegion
    
    vTable = rTable
    
    Set myDict = New Dictionary
    For i = 2 To UBound(vTable)
        sKey = vTable(i, 1) & vTable(i, 2) & vTable(i, 3) & vTable(i, 4)
        Set col = New Collection
        If Not myDict.Exists(sKey) Then
            col.Add Item:=WorksheetFunction.Index(vTable, i, 0)
            myDict.Add Key:=sKey, Item:=col
        Else
            myDict(sKey).Add Item:=WorksheetFunction.Index(vTable, i, 0)
        End If
    Next i
    
    For Each v In myDict.Keys
        Select Case myDict(v).Count
            Case 2
                Debug.Print v, "Do update for two rows"
            Case 3
                Debug.Print v, "Do update for three rows"
            Case Else
                Debug.Print v, "No update needed"
        End Select
    Next v
    
    End Sub
    

    =>

    1234V22341212 Do update for three rows
    1234v22351215 No update needed
    2234v22361515 Do update for two rows
    2234v22361311 No update needed
    

    Although, I would probably use Power Query (available in Windows Excel 2010+ and 365) which can easily group by the four columns and return a count. You can then add a new column depending on that count.

    Not knowing the nature of your updating Extra Field and the difference between what happens for 2, 3, 4, ... the same, it is not possible to supply any code for that purpose.

    In general, you would

    • expand the array for each dictionary item
    • Add the extra column if it's not already there
    • Do the update
    • Add that to a pre-dimensioned results array
    • Write the results array back to the worksheet

    Note that this method of working with VBA arrays will execute an order of magnitude faster than doing repeated worksheet accessing, but the code is longer.