VBA to highlight certain cells with specific data

[pscofe]

Hi, i'm looking for VBA code to highlight certain cells. My table below, I would like to highlight anything in local_acc_no that is "Paul, Matt, Antonia, Sebastian) and I want to highlight anything in currency that is NOT EUR, GBP or USD.
This table will change daily so some days will be less rows or more. Thanks

local_acc_no	closing_balance	currency	closing_balance_eur	stmt_date
Paul	-740,000.00​	GBP	-873,266.60​	02/07/2020​
Jack	-462,227.10​	NZD	-270,215.65​	02/07/2020​
Chris	-346,275.07​	GBP	-408,635.75​	02/07/2020​
Matt	-286,560.49​	EUR	-286,560.49​	02/07/2020​
Marianne	-16,549.07​	EUR	-16,549.07​	02/07/2020​
Antonia	-7,038.68​	GBP	-8,306.28​	02/07/2020​
Sophia	-4.00​	ISK	-0.03​	02/07/2020​
Sebastian	-0.02​	EUR	-0.02​	02/07/2020​
Suzanne	-0.01​	USD	-0.01​	02/07/2020​

 

[Akuini]

Hi, pscofe
Try this:

Sub a1123944a()
'https://www.mrexcel.com/board/threads/vba-to-highlight-certain-cells-with-specific-data.1123944/
Dim n As Long
Dim va, ary
Dim d As Object

Application.ScreenUpdating = False
    ary = Array("Paul", "Matt", "Antonia", "Sebastian")
    n = Range("A" & Rows.Count).End(xlUp).Row
    ActiveSheet.AutoFilterMode = False

Call to_Color(ary, Range("A1:A" & n))

Set d = CreateObject("scripting.dictionary"): d.CompareMode = vbTextCompare
    va = Range("C2:C" & n)
    For Each x In va
        If x <> "EUR" And x <> "GBP" And x <> "USD" Then d(x) = Empty
    Next

Call to_Color(d.keys, Range("C1:C" & n))
Application.ScreenUpdating = True
End Sub

Function to_Color(ByVal z As Variant, c As Range)
With c
    .Interior.Color = xlNone
    .AutoFilter Field:=1, Criteria1:=z, Operator:=xlFilterValues
    On Error Resume Next
    .Offset(1).Resize(.Rows.Count - 1).SpecialCells(xlCellTypeVisible).Interior.Color = vbYellow
    On Error GoTo 0
    .AutoFilter
End With
End Function

Example:

Book1
	A	B	C	D	E
1	local_acc_no	closing_balance	currency	closing_balance_eur	stmt_date
2	Paul	-740,000.00?	GBP	-873,266.60?	02/07/2020?
3	Jack	-462,227.10?	NZD	-270,215.65?	02/07/2020?
4	Chris	-346,275.07?	GBP	-408,635.75?	02/07/2020?
5	Matt	-286,560.49?	EUR	-286,560.49?	02/07/2020?
6	Marianne	-16,549.07?	EUR	-16,549.07?	02/07/2020?
7	Antonia	-7,038.68?	GBP	-8,306.28?	02/07/2020?
8	Sophia	-4.00?	ISK	-0.03?	02/07/2020?
9	Sebastian	-0.02?	EUR	-0.02?	02/07/2020?
10	Suzanne	-0.01?	USD	-0.01?	02/07/2020
Sheet3

 

[pscofe]

Hi Akuni, that looks fantastic! My sheet will always be called 'Overdrafts' how can I point that code to run on the correct sheet? Thanks

 

[Akuini]

Hi Akuni, that looks fantastic! My sheet will always be called 'Overdrafts' how can I point that code to run on the correct sheet? Thanks

Try this one:

Sub a1123944a()
'https://www.mrexcel.com/board/threads/vba-to-highlight-certain-cells-with-specific-data.1123944/
Dim n As Long
Dim va, ary
Dim d As Object

Application.ScreenUpdating = False

With Sheets("Overdrafts")
    
    ary = Array("Paul", "Matt", "Antonia", "Sebastian")
    n = .Range("A" & .Rows.Count).End(xlUp).Row
    ActiveSheet.AutoFilterMode = False

    Call to_Color(ary, .Range("A1:A" & n))
    
    Set d = CreateObject("scripting.dictionary"): d.CompareMode = vbTextCompare
        va = .Range("C2:C" & n)
        For Each x In va
            If x <> "EUR" And x <> "GBP" And x <> "USD" Then d(x) = Empty
        Next
    
    Call to_Color(d.keys, .Range("C1:C" & n))

End With

Application.ScreenUpdating = True
End Sub

Function to_Color(ByVal z As Variant, c As Range)
With c
    .Interior.Color = xlNone
    .AutoFilter Field:=1, Criteria1:=z, Operator:=xlFilterValues
    On Error Resume Next
    .Offset(1).Resize(.Rows.Count - 1).SpecialCells(xlCellTypeVisible).Interior.Color = vbYellow
    On Error GoTo 0
    .AutoFilter
End With
End Function

 

[pscofe]

simple as that! Thank you, works perfectly.

 

[Akuini]

You're welcome, glad to help, & thanks for the feedback.