Color Cell interiors in one sheet row range based on cells manually colored on another sheet.

[DaveOMatic]

Hello Board members....after reading numerous posts...which are very helpful...struggling with trying to do the following.
In sheet 1, range A:A I would color yellow selected cells of 1472 rows...using XLendUp..as the row count can vary. When I color those selected cells, that have a numeric value, I would to find match cell.values, on sheet-2, range A:A...again using VBA of XLendup and color those cell interiors yellow as well, as there are 19727 rows on sheet-2. I have tried every variation of conditional formatting and it only will match / color the first value colored in say Sheet-1, A1 and so on. Thank You in Advance. Dave W.

 

[mumps]

First color the cells in Sheet1 and then run this macro.

Sub ColorCells()
    Application.ScreenUpdating = False
    Dim srcWS As Worksheet, desWS As Worksheet, v1 As Variant, v2 As Variant, dic As Object, i As Long
    Set srcWS = Sheets("Sheet1")
    Set desWS = Sheets("Sheet2")
    v1 = srcWS.Range("A2", srcWS.Range("A" & Rows.Count).End(xlUp)).Value
    v2 = desWS.Range("A2", desWS.Range("A" & Rows.Count).End(xlUp)).Resize(, 8).Value
    Set dic = CreateObject("Scripting.Dictionary")
    For i = LBound(v2) To UBound(v2)
        If Not dic.exists(v2(i, 1)) Then
            dic.Add v2(i, 1), i + 1
        End If
    Next i
    For i = LBound(v1) To UBound(v1)
        If dic.exists(v1(i, 1)) Then
            desWS.Cells(dic(v1(i, 1)), 1).Interior.ColorIndex = 6
            srcWS.Cells(i + 1, 1).Interior.ColorIndex = 6
        End If
    Next i
    Application.ScreenUpdating = True
End Sub

 

[DaveOMatic]

First color the cells in Sheet1 and then run this macro.

Sub ColorCells()
    Application.ScreenUpdating = False
    Dim srcWS As Worksheet, desWS As Worksheet, v1 As Variant, v2 As Variant, dic As Object, i As Long
    Set srcWS = Sheets("Sheet1")
    Set desWS = Sheets("Sheet2")
    v1 = srcWS.Range("A2", srcWS.Range("A" & Rows.Count).End(xlUp)).Value
    v2 = desWS.Range("A2", desWS.Range("A" & Rows.Count).End(xlUp)).Resize(, 8).Value
    Set dic = CreateObject("Scripting.Dictionary")
    For i = LBound(v2) To UBound(v2)
        If Not dic.exists(v2(i, 1)) Then
            dic.Add v2(i, 1), i + 1
        End If
    Next i
    For i = LBound(v1) To UBound(v1)
        If dic.exists(v1(i, 1)) Then
            desWS.Cells(dic(v1(i, 1)), 1).Interior.ColorIndex = 6
            srcWS.Cells(i + 1, 1).Interior.ColorIndex = 6
        End If
    Next i
    Application.ScreenUpdating = True
End Sub

Thanks considerable Mumps...will give this a run. I was venturing towards a two-dimensional array but setting the dims always gets me. Will let you know success. Thanks

 

[DaveOMatic]

Hello and good day Mumps, thanks very much for the macro to find all values on another sheet when setting cell interior color to equal values in another sheet. Apologies for not getting back to you sooner. Have been studying your script and it does color the cell interior on the destination sheet but it does not color all equal values...only the first one. Trying to mod your script to get it to work. Example...I color the cell interior at A2 in one sheet for numerical value 123...I need it please to find ALL cell occurrences in the destination sheet of say 123 and color those yellow...so far it only colors the first find. Thanks Kindly DaveOMatic.

 

[mumps]

Try:

Sub ColorCells()
    Application.ScreenUpdating = False
    Dim srcWS As Worksheet, desWS As Worksheet, v1 As Variant, v2 As Variant, dic As Object, i As Long
    Set srcWS = Sheets("Sheet1")
    Set desWS = Sheets("Sheet2")
    v1 = srcWS.Range("A2", srcWS.Range("A" & Rows.Count).End(xlUp)).Value
    v2 = desWS.Range("A2", desWS.Range("A" & Rows.Count).End(xlUp)).Resize(, 8).Value
    Set dic = CreateObject("Scripting.Dictionary")
    For i = LBound(v1) To UBound(v1)
        If Not dic.exists(v2(i, 1)) Then
            dic.Add v1(i, 1), i + 1
        End If
    Next i
    For i = LBound(v2) To UBound(v2)
        If dic.exists(v2(i, 1)) Then
            desWS.Cells(i + 1, 1).Interior.ColorIndex = 6
            srcWS.Cells(dic(v2(i, 1)), 1).Interior.ColorIndex = 6
        End If
    Next i
    Application.ScreenUpdating = True
End Sub

 

[DaveOMatic]

Good morning Mumps....ran the revised script and it's coloring yellow a great number of cells in the SrcWS range. I selected ONLY one cell in range A:A to color yellow in the source sheet and after running it colored yellow ONLY all of the first CELL A2 in the destination sheet.

Why do we resize here please... trying to understand the syntax Of : v2 = desWS.Range("A2", desWS.Range("A" & Rows.Count).End(xlUp)).Resize(, 8).Value
Thanks considerable for your efforts.

DaveOMatic

 

[mumps]

I tested the macro on some dummy data and it worked properly. It would be easier to help if you could use the XL2BB add-in (icon in the menu) to attach screenshots (not a pictures) of your two sheets. Alternately, you could upload a copy of your file to a free site such as www.box.com or www.dropbox.com. Once you do that, mark it for 'Sharing' and you will be given a link to the file that you can post here. Explain in detail what you want to do referring to specific cells, rows, columns and sheets using a few examples from your data (de-sensitized if necessary).

 

[DaveOMatic]

Good morning Mumps....hopefully I've posted my two "sample sheets" using the requested XL2BB mini-sheet add-in.

I ONLY modified your code with Option Explicit for now.

Looking at sheet1 the "source sheet".....I've colored in A:A numerical values 1, 4 and 5.

I'm trying to get it to highlight in yellow again on sheet2 all corresponding occurrences and ONLY those.

If I go back and select another value in sheet1 A:A say 10...run the macro again...it should pick up ALL occurrences of 10 in sheet2, highlighting them yellow.

Thanks for all your help.

Color Test.xlsx
	C
29
Sheet1

Color Test.xlsx
	D
16
Sheet2

 

[mumps]

Unfortunately, that didn't work. Make sure you select the sheet range before creating the mini-sheet with the add-in.

 

[DaveOMatic]

Unfortunately, that didn't work. Make sure you select the sheet range before creating the mini-sheet with the add-in.

Thank Mumps...the instructions DID say that...new at the visual posting...will try again here shortly. Appreciate greatly the help.