OPTIMIZE my code

[BritsBlitz]

I have two worksheets. Sheet 1 contains a list of names from row 1 to 100. Sheet 2 contains a list of the same names with specific conditions from row 1 to 250. The names on Sheet 1 need to change to a specific color based on the conditions associated with that same name on Sheet2.

I have a vba code that will loop through the names on Sheet 1, compare it to the list on Sheet 2 to find its match, then look at the condition on Sheet 2 and change the text color on Sheet1 if the condition is met. Below is an example of the two sheets

Sheet1 (100 rows):

John Smith

Jane Doe

Steve Smith

Sheet2 (250 rows):

Mark Jones	No	No
John Smith	No	Yes
Jane Doe	No	No
Steve Smith	Yes	Yes
Dave Muster	No	No

If my condition specifies “Yes”, then John Smith’s & Steve Smith’s names on Sheet 1 should be highlighted in BLUE.

Below is the code I’m using. This code WORKS. What I’m asking is if there is a way to optimize the code to make it run faster. Since my code basically compares each of the 100 lines on Sheet1 x250 times to find all the matches, it takes a long time to run. Any suggestions on how to optimize this code so it doesn’t do 25,000 comparisons each time?

***********************************************
Private Sub Names()

Dim a As Integer
Dim b As Integer

For a = 1 To 100
For b = 1 To 250

If Worksheets("Sheet1").Cells(a, 1).Value = Worksheets("Sheet2").Cells(b, 1).Value And (Worksheets("Sheet2").Cells(b, 2).Value = "Yes" Or Worksheets("Sheet2").Cells(b, 3).Value = "Yes") Then
Worksheets("Sheet1").Cells(a, 1).Font.Color = RGB(0, 176, 240)
Worksheets("Sheet1").Cells(a, 1).Font.Bold = True
End If

Next b
Next a

End Sub
***********************************************

 

[offthelip]

Try this, what i have done is load all the data in sheet 2 into a variant aray, this is much faster than looping through the worksheet. Having done that, I then loop through the variant array once and build a list of all the names that need to be blue. This will cut down the size of the second loop
If this is not fast enough is it possible to speed it up further by using the dictionary object, however I thought since you only had a few hundred rows it probably isn't going to make it much faster

Sub test()
Dim BlueR(1 To 250, 1 To 1) As Variant ' set up array just to hold  blue names
inarr = Worksheets("Sheet2").Range(Cells(1, 1), Cells(250, 4)) ' note I am adding an extra column to store the colour
indi = 1
For i = 1 To 250
  If inarr(i, 2) = "Yes" Or inarr(i, 3) = "Yes" Then
   BlueR(indi, 1) = inarr(i, 1)
   indi = indi + 1
   End If
Next i
 
For i = 1 To 100
   For b = 1 To indi - 1
     If Worksheets("Sheet1").Cells(a, 1).Value = BlueR(b , 1) Then
      Worksheets("Sheet1").Cells(a, 1).Font.Color = RGB(0, 176, 240)
      Worksheets("Sheet1").Cells(a, 1).Font.Bold = True
     End If
   Next b
Next i

Note: Code is UNTEST!!!

 

[StephenCrump]

.. or you could use conditional formatting

	A
1	Sheet1
2	John Smith
3	Jane Doe
4	Steve Smith
5	Mary Contrary
6
Sheet1

Cells with Conditional Formatting
Cell	Condition		Cell Format	Stop If True
A2:A5	Expression	=OR(XLOOKUP(A2,Sheet2!A$2:A$6,Sheet2!B$2:C$6)="Yes")	text	NO

	A	B	C
1	Sheet2
2	Mark Jones	No	No
3	John Smith	No	Yes
4	Jane Doe	No	No
5	Steve Smith	Yes	Yes
6	Dave Muster	No	No
7
Sheet2

 

[BritsBlitz]

.. or you could use conditional formatting

	A
1	Sheet1
2	John Smith
3	Jane Doe
4	Steve Smith
5	Mary Contrary
6
Sheet1

Cells with Conditional Formatting
Cell	Condition		Cell Format	Stop If True
A2:A5	Expression	=OR(XLOOKUP(A2,Sheet2!A$2:A$6,Sheet2!B$2:C$6)="Yes")	text	NO

	A	B	C
1	Sheet2
2	Mark Jones	No	No
3	John Smith	No	Yes
4	Jane Doe	No	No
5	Steve Smith	Yes	Yes
6	Dave Muster	No	No
7
Sheet2

Hi @StephenCrump I initially used conditional formatting, but that in itself was slow since I had multiple rules for different colors. The example I used was just one color, but there are more. Conditional formatting worked as well, but even slower which is why I figured I'd try VBA. I'll give the variant array suggestion a try.

 

[dmt32]

The example I used was just one color, but there are more.

Hi

Assuming that the names will appear only ONCE in column A of each of your sheets then see if this attempt to update to your code is any faster for you.

Sub BritsBliz(ByVal NameColor As XlRgbColor)
    Dim ws(1 To 2)          As Worksheet
    Dim SheetData(1 To 2)   As Variant, m As Variant
    Dim StaffName           As Variant
    Dim r                   As Long, i As Long
    Dim rng                 As Range
    
    Application.ScreenUpdating = False
    
    For i = 1 To 2
        Set ws(i) = ThisWorkbook.Worksheets("Sheet" & i)
        SheetData(i) = ws(i).UsedRange.Value
    Next
    
    'reset range
    With ws(1).Columns(1): .Font.ColorIndex = xlAutomatic: .Font.Bold = False: End With
    
    For Each StaffName In Application.Index(SheetData(1), 0, 1)
        r = r + 1
        'find name
        m = Application.Match(StaffName, Application.Index(SheetData(2), 0, 1), 0)
        If Not IsError(m) Then
            'find yes in matched row
            If Not IsError(Application.Match("Yes", Application.Index(SheetData(2), m, Application.Transpose(Array(2, 3))), 0)) Then
                'set object variable to ws1 range
                If rng Is Nothing Then
                    Set rng = ws(1).Cells(r, 1)
                Else
                    Set rng = Union(ws(1).Cells(r, 1), rng)
                End If
            End If
        End If
    Next
    'highlight all matched names in one go
    If Not rng Is Nothing Then
        rng.Font.Color = NameColor
        rng.Font.Bold = True
    End If
    Application.ScreenUpdating = True
End Sub

Solution reads both sheets’ data into variant arrays which are used in the main loop to perform the checks between worksheets. If Second sheet meets criteria, Union method is used to combine all matched ranges into a single range which applies the required colour in one go once loop has finished.

Also, as you stated that there are more colours to apply & bit of a guess, I have added a parameter to the code to enable you to pass required RGB Color as an argument – you can either select colour from the IntelliSense list of specify a colour.

Example

   BritsBliz RGB(0, 176, 240)

or select from list

Solution has only been lightly tested but hopefully, will meet your need


Hope Helpful



Dave

 

[BritsBlitz]

Try this, what i have done is load all the data in sheet 2 into a variant aray, this is much faster than looping through the worksheet. Having done that, I then loop through the variant array once and build a list of all the names that need to be blue. This will cut down the size of the second loop
If this is not fast enough is it possible to speed it up further by using the dictionary object, however I thought since you only had a few hundred rows it probably isn't going to make it much faster

Sub test()
Dim BlueR(1 To 250, 1 To 1) As Variant ' set up array just to hold  blue names
inarr = Worksheets("Sheet2").Range(Cells(1, 1), Cells(250, 4)) ' note I am adding an extra column to store the colour
indi = 1
For i = 1 To 250
  If inarr(i, 2) = "Yes" Or inarr(i, 3) = "Yes" Then
   BlueR(indi, 1) = inarr(i, 1)
   indi = indi + 1
   End If
Next i
 
For i = 1 To 100
   For b = 1 To indi - 1
     If Worksheets("Sheet1").Cells(a, 1).Value = BlueR(b , 1) Then
      Worksheets("Sheet1").Cells(a, 1).Font.Color = RGB(0, 176, 240)
      Worksheets("Sheet1").Cells(a, 1).Font.Bold = True
     End If
   Next b
Next i

Note: Code is UNTEST!!!

Thanks, this works great. It runs about 5x faster using the variant array