Search value in array and color if meats conditions

[pupsia]

Hello all!

I`m trying to write a macro that goes through all cell in AQ column, splits information in every cell into array and if conditions are met, color the cell.

#	AQ COLUMN
1 line	Email Address
2 line	Name Surname; Name.Surname@email.com;
3 line	Name Surname; Surname@email.com; Surname@email.com
4 line	NameSurname; Name.Surname@email.com
5 line	Name.Surname@email.com
6 line	Name Surname;
7 line	Name Surname
8 line	Name.Surname@email.com; Name.Surname@email.com
9 line	Name.Surname@email.com;Name.Surname@email.com
10 line	Name.Surname@email.com; Name.Surname@email.com;
11 line	Surname@email.com; Name Surname; Surname@email.com
12 line	Name.Surname@email..com
13 line
14 line	NameSurname; Name.Surname@email.com
15 line	Name.Surname@email.com

<tbody>
</tbody>

The code I`m using is below. No errors pop up. But nothing is colored. This macro should find some bad cells in the table above. The lines that should be colored are: 2, 3, 4, 6, 7, 11, 12, 14 Any ideas where I made a mistake? Please help! Sub Test_Test_Test_Test_Test() Dim r As Range Dim h As Integer Dim j As Integer Dim ar() As String Set WB = ThisWorkbook.Worksheets("Bulk") With WB LastRow = .Cells(.Rows.Count, "AQ").End(xlUp).Row End With Set r = WB.Range("AQ" & LastRow) For h = 2 To LastRow If WB.Range("AQ" & h).Value <> "" Then: GoTo home ar = Split(WB.Range("AQ" & h).Value, ";") If UBound(ar) >= 0 Then For j = 0 To UBound(ar) If ar(j) Like "*..*" Then WB.Range("AQ" & h).Interior.ColorIndex = 45 If Not ar(j) Like "*@*" Then WB.Range("AQ" & h).Interior.ColorIndex = 45 If Not ar(j) Like "*.*" Then WB.Range("AQ" & h).Interior.ColorIndex = 45 Next End If home: Next End Sub

<colgroup><col></colgroup><tbody>
</tbody>

 

[JackDanIce]

Untested, try:

Sub Test()
    
    Dim a() As String
    Dim r   As Range
    Dim LR  As Long
    Dim x   As Long
    
    Const DELIM As String = ";"
    
    Application.ScreenUpdating = False
        
    With Sheets("Bulk")
        If .AutoFilterMode Then .AutoFilterMode = False
        LR = .Cells(.Rows.count, 43).End(xlUp).row
        .Cells(1, 43).Resize(LR).AutoFilter Field:=1, Criteria1:="="
        For Each r In .Cells(1, 43).Resize(LR).SpecialCells(xlCellTypeVisible)
            a = Split(r.Value, DELIM)
            For x = LBound(a) To UBound(a)
                If InStr(a(x), "..") Or InStr(a(x), "@") Or InStr(a(x), ".") Then Rng.Interior.ColorIndex = 45
            Next x
            Erase a
        Next r
        .AutoFilterMode = False
    End With
            
    Application.ScreenUpdating = True
    
End Sub

 

[pupsia]

JackDanIce, thank you for your response Not sure why, but nothing is happening for some reason

After a while I changed one line and now is seems to work, more or less.

If WB.Range("AQ" & h).Value = "" Then: GoTo home

Thank you for your help!

 

[JackDanIce]

You do not need that line at all, can you post the code that is working for you?

This line should field column number 43 (AQ) for values that are blank

.Cells(1, 43).Resize(LR).AutoFilter Field:=1, Criteria1:="="

For none blanks, change code to:

.Cells(1, 43).Resize(LR).AutoFilter Field:=1, Criteria1:="<>"