I have several dates on the Column D of sheet 2. I want to search the first row of sheet 1 and if the same date is found colour the cells but can’t seem to make it work.
I believe the issue is on the ranges, but tried several ways and nothing works.
Please see my code below:
Sub test2() Dim xcel As Range Dim ycel As Range Dim WS1 As Worksheet Dim WS2 As Worksheet Dim lc As Long Dim lr As Long Set WS1 = ThisWorkbook.Worksheets("sheet1") Set WS2 = ThisWorkbook.Worksheets("sheet2") lc = WS1.Cells(1, Columns.Count).End(xlToLeft).Column lr = WS2.Range("D" & Rows.Count).End(xlUp).Row With WS1 For Each xcel In .Range(Cells(1, 1), Cells(1, lc)) For Each ycel In WS2.Range(Cells(2, 4), Cells(lr, 4)) If xcel.Value = ycel.Value Then xcel.Interior.ColorIndex = 6 xcel.Font.ColorIndex = 1 End If Next ycel Next xcel End With End Sub
thank you in advance
Please, test the next way. It uses two arrays, for faster iteration against iteration between each cells and create a
Union range for the matching cells, which to be colored at the end, at once:
Sub test2ColorCellInt() Dim WS1 As Worksheet, arr1, WS2 As Worksheet, arr2 Dim lc As Long, lr As Long, i As Long, j As Long, rngCol As Range Set WS1 = ThisWorkbook.Worksheets("sheet1") Set WS2 = ThisWorkbook.Worksheets("sheet2") lc = WS1.cells(1, Columns.count).End(xlToLeft).Column lr = WS2.Range("D" & rows.count).End(xlUp).row arr1 = WS1.Range(WS1.cells(1, 1), WS1.cells(1, lc)).value 'place the range in an array for faster iteration arr2 = WS2.Range(WS2.cells(2, 4), WS2.cells(lr, 4)).value 'place the range in an array for faster iteration For i = 1 To UBound(arr1, 2) 'iterate on columns of arr1: For j = 1 To UBound(arr2) 'iterate between rows of arr2: If arr1(1, i) = arr2(j, 1) Then 'in case of a match: If rngCol Is Nothing Then 'if the range to keep the matching cells is nothing Set rngCol = WS1.cells(1, i) 'create the range Else Set rngCol = Union(rngCol, WS1.cells(1, i)) 'make a Union between existing and the matching cell End If End If Next j Next i If Not rngCol Is Nothing Then 'if the range exists, do the job: rngCol.Interior.ColorIndex = 6 rngCol.Font.ColorIndex = 1 End If End Sub
It, probably, will be good to preliminarily clear the format of the first row existing cells, to see the differences when running the code next time, but if not requested, I did not include such an approach…
Your existing code wrongly qualified the used ranges, using the same
cells of the active sheet for building both of them. But I tried to supply a faster way of dealing with the issue.
Answered By – FaneDuru
Answer Checked By – Mildred Charles (AngularFixing Admin)