Searching Excel Using VBA In A Specific Way-CodePudding

I would like to create an excel macro that searches through a sheet and highlights cells and between cells dependant on the values inside the cells.

For each Column in sheet
   For Each Cell in Column
      val = Cell.Value
      valAddress = Cell.Address
      
      If val == ("=<") AND ActiveCell.Colour == NOT green
         startSelect = valAddress

      ElseIf val == ("==") AND ActiveCell.Colour == NOT green
         set cell.colour = green

      ElseIf val == (">") AND startSelect == NOT Nothing AND ActiveCell.Colour == NOT green
         Select Cells From startSelect to Active.Cell
         Set Cell.Colour = Green
         val = 0
         startSelect = NULL
         valaddress = 0 

      ElseIf Cell == Final Cell in Column and startSelect == NOT Nothing
         Select Cells From startSelect to Active.Cell
         Set Cell.Colour = Green
         val = 0
         startSelect = NULL
         valaddress = 0

I have tried to write this in actual VBA to minimal success. Is anyone aware of how to search down each column and how to find out when you're at the bottom of your sheet?

I basically want to recreate the highlighting in the attached photo but create a program that highlights automatically.

Outcome:

Many thanks in advance!!

See my attempt below

Sub btnFillTableColour()

Dim i As Integer
Dim j As Integer
Dim k As Integer
Dim row As Integer
Dim cellValue As String

For i = 6 To 196
    For j = 7 To 305
        cellValue = Cells(i, j)
        If cellValue = (">=") And ws.Cells(i, j).Interior.Color = RGB(0, 0, 0) Then
            row = j
            col = i
            cellValue = 0
        ElseIf cellValue = ("==") And ws.Cells(i, j).Interior.Color = RGB(0, 0, 0) Then
            Cells(i, j).Interior.Color = vbGreen
            cellValue = 0
        ElseIf cellValue = ("<") And ws.Cells(i, j).Interior.Color = RGB(0, 0, 0) Then
            For k = row To j
                Cells(k, j).Interior.Color = vbGreen
            Next k
            k = 0
            row = 0
            cellValue = 0
            
        ElseIf j = 304 And ws.Cells(i, j).Interior.Color = RGB(0, 0, 0) And row > 0 Then
            For k = row To j
                Cells(k, j).Interior.Color = vbGreen
            Next k
            k = 0
            row = 0
            cellValue = 0
    Next j
Next i

End Sub

CodePudding user response：

If I understand you correctly ...

The beginning condition and the expected result is like the animation above.

So if the animation above is similar with your expectation....

Sub test()
Dim colCount As Integer: Dim col As Integer
Dim rg As Range: Dim rg1 As Range: Dim rg2 As Range
Dim arr1: Dim arr2: Dim i As Integer: Dim cnt As Integer

'get how many columns of the header range as colCount variable - change as needed
colCount = Range("A1", Range("A1").End(xlToRight)).Columns.Count

'loop to each column of the header
For col = 1 To colCount

'set the range of data in the looped column as rg variable
    Set rg = Range(Cells(1, col), Cells(Rows.Count, col).End(xlUp))
    
'set the range which has >= as rg1 varibale and which has < as rg2 variable
    With rg
        .Replace ">=", True, xlWhole, , False, , False, False
        Set rg1 = .SpecialCells(xlConstants, xlLogical)
        .Replace True, ">=", xlWhole, , False, , False, False
        .Replace "<", True, xlWhole, , False, , False, False
        Set rg2 = .SpecialCells(xlConstants, xlLogical)
        .Replace True, "<", xlWhole, , False, , False, False
    End With

'get how many constant value are there in rg1 as cnt variable
'and check if it's the same with the count of constant value in rg2
'then get both rg1 and rg2 address as arr1 and arr2 variable
'then finally loop as many as the count value
'and apply the color according to the header color of the respective column
    cnt = Application.CountA(rg1)
        If cnt = Application.CountA(rg2) Then
            arr1 = Split(rg1.Address, ",")
            arr2 = Split(rg2.Address, ",")
                For i = 0 To cnt - 1
                    Range(arr1(i), arr2(i)).Interior.Color = Cells(1, col).Interior.Color
                Next
        End If
Next

End Sub

The code assumes that each header column has already the background color, so the coloring of each range in between >= and < is the same color with the header of the respective column.

The code also assumes that there will be no consecutive appearance of ">=" or "<" in each column. So, there won't be something like this (for example) : cell A3 value ">=", cell A10 value ">=" then the first appearance of "<" is in cell A13.

The code will fail if in each column, the count of ">=" existence is not the same of the count of "<".