Color matching date through VBA

[xsmurf]

Hi Experts,

I have a problem with coloring matching values through VBA.
I have posted this on a different forum, but I really need a solution for my issue.
Link to the cross-post: Ozgrid

I have a sheet called "Filtered Vacations", that retrieves filtered data from a different workbook. This work good.
In cell B4 to O4 I have dates, and under those dates are the filtered values from the other workbook.
The list of values under those dates are not fixed and change depending on the values that have been retrieved.
So each date has a separate set of values.

I also have 7 sheets that represent the days of the week ("Mon,"Tue", "Wed",...)
In those sheets on cell I3 I have a date.
The date on "Mon" is in the format "mm/dd/yyyy" the rest of the sheets are a link to the "Mon"sheet by adding +1 to the date.

The actual range of the columns that I want to use in my code is Range("C9:C65,E9:E65,G9:G59,I9:I65,K9:K65,M9:M65,O9:O65,C77:C133,E77:E133,G77:G127,I77:I133,K77:K133,M77:M133,O77:O133,C145:C201,E145:E201,G145:G195,I145:I201,K145:K201,M145:M201,O145:O201")

I would like to have a vba code that does the following:
It needs to take the date from cell I3 in the 7-sheets and check / compare that with the dates in "Filtered Vacations". Range (B4:O4)
If a match is found then the values in "Filtered Vacations" that are below the cell with that date needs to be checked in that sheet where the date was found. (one of the 7-sheets). When a match is found that cell needs to be colored light grey in one of the 7-sheets.

For example: If a date is found on cell G4 that matches the date in sheet "Wed" than the values from the column G need to be compared with the values in the columns/range in sheet "Wed".
When a match is found that cell needs to be colored light grey.

The values in sheet "Filtered Vacations" are numbers (xxx). The values in the 7 sheets that represent the days of the week are a combination of numbers & letters (" xxx x.xxxxxx). The match should be only on the 3 numbers ( the combination always starts with 3 numbers and then letters)

I am trying to adjust the following VBA code, but I have no luck with that.
This code works partially, because it colors ALL the values that are found in the sheet "Filtered Vacations" and it does not just look at the date and the values below that date.

I hope someone can help me with my issue, any help is appreciated.

Sub ColorMatchingCells()
    Dim wsMon As Worksheet
    Dim wsFilteredVacations As Worksheet
    Dim cellMon As Range
    Dim cellFilteredVacations As Range
    Dim targetRanges() As Variant
    Dim targetRange As Range
    Dim i As Integer
    Dim filteredValue As String
    Dim monValue As String

    Set wsMon = ThisWorkbook.Sheets("Mon")
    Set wsFilteredVacations = ThisWorkbook.Sheets("Filtered Vacations")

    targetRanges = Array( _
        wsMon.Range("C9:C65,E9:E65,G9:G59,I9:I65,K9:K65,M9:M65,O9:O65"), _
        wsMon.Range("C77:C133,E77:E133,G77:G127,I77:I133,K77:K133,M77:M133,O77:O133"), _
        wsMon.Range("C145:C201,E145:E201,G145:G195,I145:I201,K145:K201,M145:M201,O145:O201"))

    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual

    For i = LBound(targetRanges) To UBound(targetRanges)
        Set targetRange = targetRanges(i)

        For Each cellFilteredVacations In wsFilteredVacations.Range("B5:O40")
            If Not IsEmpty(cellFilteredVacations) Then
                filteredValue = Left(cellFilteredVacations.Value, 3)
                For Each cellMon In targetRange
                    If Not IsEmpty(cellMon) Then
                        monValue = Left(cellMon.Value, 3)
                        If monValue = filteredValue Then
                            cellMon.Interior.Color = RGB(192, 192, 192) ' Light grey color
                        End If
                    End If
                Next cellMon
            End If
        Next cellFilteredVacations
    Next i

    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
End Sub

 

[DanteAmor]

Hi @xsmurf . I hope you are well.

Try the following code.
It puts the color on both sheets, on the "mon", "Tue" sheets... and also on the "filtered vacation" sheet.

Sub ColorMatchingCells()
  Dim f As Range, f2 As Range, c As Range, rng As Range
  Dim wsh As Variant, w As Variant
  Dim shFV As Worksheet
  Dim cell As String
  Dim lr As Long
 
  Set shFV = Sheets("Filtered Vacations")
  wsh = Array("Mon", "Tue", "Wed", "Thu", "Fri", "Sat", "Sun")
 
  shFV.Range("B5", shFV.Cells(Rows.Count, Columns.Count)).Interior.Color = xlNone
  For Each w In wsh
    Set f = shFV.Range("B4:O4").Find(Sheets(w).Range("I3").Value, , xlFormulas, xlWhole)
    If Not f Is Nothing Then
      lr = shFV.Cells(Rows.Count, f.Column).End(3).Row
      If lr > 4 Then
        Set rng = Sheets(w).Range("C9:C65,E9:E65,G9:G59,I9:I65,K9:K65,M9:M65,O9:O65," & _
                  "C77:C133,E77:E133,G77:G127,I77:I133,K77:K133,M77:M133,O77:O133," & _
                  "C145:C201,E145:E201,G145:G195,I145:I201,K145:K201,M145:M201,O145:O201")
       
        rng.Interior.Color = xlNone
        For Each c In shFV.Range(shFV.Cells(5, f.Column), shFV.Cells(lr, f.Column))
       
          Set f2 = rng.Find(c.Value & "*", , xlValues, xlWhole)
          If Not f2 Is Nothing Then
            c.Interior.Color = RGB(192, 192, 192)     'If you want the color in the cell on filter vacation sheet
            cell = f2.Address
            Do
              f2.Interior.Color = RGB(192, 192, 192)  'Light grey color, on the week sheet
              Set f2 = rng.FindNext(f2)
            Loop While f2.Address <> cell
          End If
         
        Next
      End If
    End If
  Next
End Sub

I did tests with your file. Match_vba dam

Note: You should try several numbers, some that existed on both sheets and other numbers that did not exist. If all numbers from the "filtered vacation" sheet exist in the "mon" sheet, then all numbers will be highlighted.

----- --
Let me know the result and I'll get back to you as soon as I can.
Sincerely
Dante Amor
----- --

 

[xsmurf]

Hi @xsmurf . I hope you are well.

Try the following code.
It puts the color on both sheets, on the "mon", "Tue" sheets... and also on the "filtered vacation" sheet.

Sub ColorMatchingCells()
  Dim f As Range, f2 As Range, c As Range, rng As Range
  Dim wsh As Variant, w As Variant
  Dim shFV As Worksheet
  Dim cell As String
  Dim lr As Long
 
  Set shFV = Sheets("Filtered Vacations")
  wsh = Array("Mon", "Tue", "Wed", "Thu", "Fri", "Sat", "Sun")
 
  shFV.Range("B5", shFV.Cells(Rows.Count, Columns.Count)).Interior.Color = xlNone
  For Each w In wsh
    Set f = shFV.Range("B4:O4").Find(Sheets(w).Range("I3").Value, , xlFormulas, xlWhole)
    If Not f Is Nothing Then
      lr = shFV.Cells(Rows.Count, f.Column).End(3).Row
      If lr > 4 Then
        Set rng = Sheets(w).Range("C9:C65,E9:E65,G9:G59,I9:I65,K9:K65,M9:M65,O9:O65," & _
                  "C77:C133,E77:E133,G77:G127,I77:I133,K77:K133,M77:M133,O77:O133," & _
                  "C145:C201,E145:E201,G145:G195,I145:I201,K145:K201,M145:M201,O145:O201")
      
        rng.Interior.Color = xlNone
        For Each c In shFV.Range(shFV.Cells(5, f.Column), shFV.Cells(lr, f.Column))
      
          Set f2 = rng.Find(c.Value & "*", , xlValues, xlWhole)
          If Not f2 Is Nothing Then
            c.Interior.Color = RGB(192, 192, 192)     'If you want the color in the cell on filter vacation sheet
            cell = f2.Address
            Do
              f2.Interior.Color = RGB(192, 192, 192)  'Light grey color, on the week sheet
              Set f2 = rng.FindNext(f2)
            Loop While f2.Address <> cell
          End If
        
        Next
      End If
    End If
  Next
End Sub

I did tests with your file. Match_vba dam

Note: You should try several numbers, some that existed on both sheets and other numbers that did not exist. If all numbers from the "filtered vacation" sheet exist in the "mon" sheet, then all numbers will be highlighted.

----- --
Let me know the result and I'll get back to you as soon as I can.
Sincerely
Dante Amor
----- --

@DanteAmor
Thank you for your reply, appreciate the work you have done.
I have tried some numbers and at first glance it looks very good.
I am going to put this in a copy of the original file and see how it will turn out. Will keep you posted

Again thank you

 

[xsmurf]

@DanteAmor
So I implemented the solution into the original file and noticed I have 2 issues.

1) If the number that is retrieved is for example 80 but the number/name in the 7-sheets is "080 H.Alloween" it will not always color the cell light grey
I tried changing the formats, but that makes no difference. The setup of cells is the same as in the test file.

2) It is also coloring some cells while the numbers are not even in the filtered list.
For example "287 C.Tree" is colored light grey, but 287 is not in the filtered list, not even in partial matches
It does that for several number/letter combinations.

Tried adjusting the following code xlWhole to xlPart it seems to work for issue 1, but I will run the risk that other cells are colored even though they are not in the list. So I left that at xlWhole.

Set f2 = rng.Find(c.Value & "*", , xlValues, xlWhole) ' xlWhole or xlPart

Could you give some insight ?

Thank you for any help

 

[DanteAmor]

Tried adjusting the following code xlWhole to xlPart it seems to work for issue 1, but I will run the risk that other cells are colored even though they are not in the list. So I left that at xlWhole.

That's correct, if you search for 80 and want 080 to be highlighted, 180, 280, etc. will also be highlighted.

I suggest that on the Filtered Vacations sheet, you put the full number 080, 123, 035, etc.

2) It is also coloring some cells while the numbers are not even in the filtered list.
For example "287 C.Tree" is colored light grey, but 287 is not in the filtered list, not even in partial matches
It does that for several number/letter combinations.

It doesn't happen in my tests, probably that number was already highlighted before the run.

If the problem persists, share your file for review.

 

[xsmurf]

That's correct, if you search for 80 and want 080 to be highlighted, 180, 280, etc. will also be highlighted.

I suggest that on the Filtered Vacations sheet, you put the full number 080, 123, 035, etc.


It doesn't happen in my tests, probably that number was already highlighted before the run.

If the problem persists, share your file for review.

yes, so my problem was indeed how 080 or 80 was showing, I made sure that when I retrieve the numbers it is now retrieving 3 numbers.
All of my problems disappeared after that.
Thank you so much for the help. Appreciate it.