Simple, but slow code, any ways to speed it up?

[Upex]

Hi folks,

Wonder if anyone can offer a suggestion(s) as to get this to run quicker please, as taking an age and the sheet is only about 1,000 rows at the moment. I'm using Excel 2013 if it makes a difference.

The search columns, O and AD can contain just the name, or lots of text with the name at start, end or in middle, and could have more than one name in them. They are free text columns, so can contain pretty much anything, hence I need to check the whole contents to see if the names are somewhere within it (ie can't do cell value etc).

Obviously if there is a less onerous way to achieve the same results, I'm open to those, this is just the only way I could think of/get working as hardly use vba anymore and I can't remember jack!

Cheers all, Upex

Sub Highlight_Left_Columns()
 
'Adds a 'Yes' in columns A-H for each row to identify if the respective search text is found within each rows O or AD column as part of the cells contents (sole entry or within its string)

Application.ScreenUpdating = False

Dim lngI As Integer
 
For lngI = 2 To Cells.SpecialCells(xlCellTypeLastCell).Row
   
    If InStr(1, Range("O" & lngI).Value, "Alex", vbTextCompare) Then
        Range("A" & lngI).Value = "Yes"
    If InStr(1, Range("O" & lngI).Value, "Brian", vbTextCompare) Then
        Range("b" & lngI).Value = "Yes"
    If InStr(1, Range("O" & lngI).Value, "Claire", vbTextCompare) Then
        Range("c" & lngI).Value = "Yes"
    If InStr(1, Range("O" & lngI).Value, "Darren", vbTextCompare) Then
        Range("d" & lngI).Value = "Yes"
    If InStr(1, Range("O" & lngI).Value, "Erica", vbTextCompare) Then
        Range("e" & lngI).Value = "Yes"
    If InStr(1, Range("O" & lngI).Value, "Francis", vbTextCompare) Then
        Range("f" & lngI).Value = "Yes"
    If InStr(1, Range("O" & lngI).Value, "Gary", vbTextCompare) Then
        Range("g" & lngI).Value = "Yes"
    If InStr(1, Range("O" & lngI).Value, "Harry", vbTextCompare) Then
        Range("h" & lngI).Value = "Yes"
    End If
    End If
    End If
    End If
    End If
    End If
    End If
    End If
  
    
    If InStr(1, Range("AD" & lngI).Value, "Alex", vbTextCompare) Then
        Range("A" & lngI).Value = "Yes"
    If InStr(1, Range("AD" & lngI).Value, "Brian", vbTextCompare) Then
        Range("b" & lngI).Value = "Yes"
    If InStr(1, Range("AD" & lngI).Value, "Claire", vbTextCompare) Then
        Range("c" & lngI).Value = "Yes"
    If InStr(1, Range("AD" & lngI).Value, "Darren", vbTextCompare) Then
        Range("d" & lngI).Value = "Yes"
    If InStr(1, Range("AD" & lngI).Value, "Erica", vbTextCompare) Then
        Range("e" & lngI).Value = "Yes"
    If InStr(1, Range("AD" & lngI).Value, "Francis", vbTextCompare) Then
        Range("f" & lngI).Value = "Yes"
    If InStr(1, Range("AD" & lngI).Value, "Gary", vbTextCompare) Then
        Range("g" & lngI).Value = "Yes"
    If InStr(1, Range("AD" & lngI).Value, "Harry", vbTextCompare) Then
        Range("h" & lngI).Value = "Yes"
   
    End If
    End If
    End If
    End If
    End If
    End If
    End If
    End If
    Next lngI
 
 
'Application.ScreenUpdating = True
 
End Sub

 

[Macumba]

Hi The below is the code for you.

Option Base 1
Sub test()
Dim myarray As Variant
myarray = Array("Alex", "Brian", "Claire", "Darren")
row_n = 2
For i = 1 To 4
valselected = Cells(row_n, 15)
If myarray(i) = valselected Then
Cells(row_n, i).Value = "yes"
End If
row_n = row_n + 1
Next i
End Sub

Use do until to loop the number of rows

 

[dmt32]

Hi,
untested but see if this is any faster & does what you want:

Option Base 1
Sub Highlight_Left_Columns()
    Dim arr As Variant, m As Variant
    Dim rng As Range, Cell As Range, MatchName As Range
    Dim lngI As Long
    
    lngI = Cells.Find(What:="*", Lookat:=xlPart, LookIn:=xlFormulas, SearchOrder:=xlByRows, _
    SearchDirection:=xlPrevious, MatchCase:=False).Row
    
    Set rng = Range("O2:O" & lngI, "AD2:AD" & lngI)
    
    arr = Array("Alex", "Brian", "Claire", "Darren", "Erica", "Francis", "Gary", "Harry")
    
    For Each Cell In rng.Cells
        m = Application.Match(Cell.Value, arr, False)
        If Not IsError(m) Then
            If MatchName Is Nothing Then
                Set MatchName = Cells(Cell.Row, CInt(m))
            Else
                Set MatchName = Union(MatchName, Cells(Cell.Row, CInt(m)))
            End If
        End If
    Next
    
    'add Yes to all matched rows in one go
    If Not MatchName Is Nothing Then MatchName.Value = "Yes"
End Sub

Note:
- Option Base 1 statement which MUST be at top of module outside of any procedure.
- Ranges are unqualified and it is assumed correct sheet will be the active sheet.

Dave

 

[Upex]

Thanks Macumba, I've tried this but no joy. Although I'm not sure where the do until loop should be sitting.

This:

Sub test()Dim myarray As Variant
Dim fulltimer As Date
fulltimer = Now()
myarray = Array("Alex", "Brian", "Claire", "Darren", "Erica", "Francis", "Gary", "Harry")
row_n = 2


For i = 1 To 8
Do Until row_n = 565 'Cells.SpecialCells(xlCellTypeLastCell).Row
valselected = Cells(row_n, 15)
If myarray(i) = valselected Then
Cells(row_n, i).Value = "yes"
End If
row_n = row_n + 1
Loop
Next i
MsgBox Format(Now() - fulltimer, "hh:mm:ss")
End Sub

Run's in 0s (I added the timer so could compare results) with no errors etc - but populates nothing within A:H - as if it's found no matches, or not checked anything etc.

I believe this may be because it's looking for Alex as the cell value, rather than the cell value having Alex within its string? I think this as having changed a cell from "Completed by Alex" to just "Alex" - it found it and marked up A:A on the appropriate row.

Any ideas how I can have it check the entire string of text to see if the array value is within it? I've tried "*Alex*"...., but it still finds nothing.

DMT32
Thanks for this, I've copied across with the Option base statement as described and with the sheet as the active sheet, but this code also runs in 0s (no errors) but populates 0 results (there should be over 1000 "Yes"s within A:H when flagged correctly).

Likewise to Macumbas code, yours also flags up correctly when I change a cell in O:O to be just "Alex", so appears that it to is not searching within the cells text, rather looking at its specific value, as per Macumbas.

Adding *s to the search array elements doesn't work either - in fact with the "*Alex*" it fails to even flag "Alex".

Thanks for the help thus far, and any ideas on how this can be tweaked (as the code is dream compared to my repetitive one - so much rather this regardless of speed to be honest) to search within the string, would be much appreciated.