Comparing two Arrays

[Guinaba]

Hi guys,

Wondering if someone could help me out. I have to compare the col.3 (Av. Prod) against the headers from col. 6 onwards, considering that from col.6 to col. 9 is week/year and col. 10 to Lastcol is mm-yyyy format, if the values match then color the cell below the header. I have done only the first comparison considering week/year, I still need to create another arr3 to compare with mmm-yyyy.

But if the values match, not sure how I can color the cell below.

I have created the following code:

Public Sub Compare_Arrays()

    Dim iLoop1 As Integer, iLoop2 As Integer
    Dim lCol As Integer, lRow As Integer, r As Integer, c As Integer, rr As Integer
    Dim result As String
    lCol = cells(11, Columns.Count).End(xlToLeft).Column
    lRow = cells(Rows.Count, 4).End(xlUp).row

    'Arrays
    Dim arr1() As Variant '(col.D) - date format
    Dim arr2() As Variant 'Header in week/year format row 11 col. 6 to 14
    Dim arr3() As Variant 'Header in Mth/Year format row 11 col. 15 to LastCol

    'Ranges
    Dim rng1 As Range
    Set rng1 = Range(cells(12, 4), cells(lRow, 4))
    Dim rng2 As Range 'Header in week/year format
    Set rng2 = Range(cells(11, 6), cells(11, 14))
    Dim rng3 As Range 'Header in Mth/Year format
    Set rng3 = Range(cells(11, 16), cells(11, lCol))


    'Converting Date to Week/Year - Range col. D (arr1)
    
    For r = 1 To rng1.Rows.Count
        ReDim Preserve arr1(1 To lRow)
        Dim D As Variant
        Dim DNewFormat As Variant 'have to use MM/DD/YYYY for the week number to work correctly
        Dim DWY As Variant
        D = rng1.cells(r, 1).Value
        DNewFormat = Format(D, "MM/dd/yyyy")
        DWY = Sheets(1).Application.WorksheetFunction.WeekNum(DNewFormat, vbMonday) & "/" & Year(rng1.cells(r, 1).Value)
        arr1(r) = DWY
     Next
    
    'Populating (arr2)
    For c = 1 To rng2.Columns.Count
        'ReDim Preserve arr2(1 to C)
        arr2(c) = rng2.cells(c)
    Next
    
'Comparing arrays arr1 and arr2
    For iLoop1 = LBound(arr1) To UBound(arr1)
      For iLoop2 = LBound(arr2) To UBound(arr2)
        If arr1(iLoop1) = arr2(iLoop2) Then
          result = result & arr1(iLoop1) & ", "
        End If
    Next
    Next
    result = Left(result, Len(result) - 2)
    MsgBox result
End Sub

 

[Snakehips]

@Guinaba You would need to check the offset values(11, & 4) but I imagine that something like the following.

'Comparing arrays arr1 and arr2
Application.ScreenUpdating = False    '**prevent constant screen updating while looping

    For iLoop1 = LBound(arr1) To UBound(arr1)
      For iLoop2 = LBound(arr2) To UBound(arr2)
        If arr1(iLoop1) = arr2(iLoop2) Then

      Cells(iLoop1 + 11, iLoop2 + 4).Interior.Color = 5296274

'  blaa.  blaa


Application.ScreenUpdating = True   're establish screen updating
End Sub

** perhaps comment out this line while stepping through to test but reinstate when all is good

Hope that helps.

 

[Guinaba]

Thanks @Snakehips! You are legend! Got the idea! Just need to twik a little bit the code.