Help with a For Loop that compares and formats cells in a range

seattletimebandit

Board Regular
Joined
Apr 11, 2013
Messages
69
I'm looking to write a macro that loops through a table to compare data and make format changes.

I have a table that I need to compare data in cells in a Range (by selecting the range) to data in other cells (all in a single Column down to x rows). If the data in the Selected Range is ">=" the data in the adjacent Column C, then the cells in the Range that meet certain criteria are highlighted.

The criteria are that if the cell is empty or if there is some text, ignore it, only numeric values need to be highlighted.

I've tried to "talk" it out by the following:


  1. Check to see if there are any numbers in the cells in column B (starting in B3 down to B100), if the cell is empty, continue down each row in column B until a number is found.
  2. if a numeric value is found in the cell in Column B, then starting checking cells in the Selected Range, moving to the right (Column 3 through Column 103) in that same row, searching for numeric values to the end of row (ending at Column 103)
  3. if a cell is blank or has text (non-numeric) keep moving along the row to the end
  4. if cell has a numeric value, compare it to the value found Column B (in that same row) do the following
    1. if value is "<" the column B value, ignore it
    2. if cell value is ">=" to the Column B value, change cell color (I have a bit of formatting code for that)
  5. After checking and changing the cells with values in the row, move to next row starting back in Column C
  6. repeat above until no data found (col 100, row 100)

The following snippet works when selecting a row and comparing the cells in the selection to a specific cell ($B3). Some the data in cells are numbers:
1.25, 5.13, etc. and some have a letter 0.500 U, 1.00 U. I'm ignoring the cells with "U's".

I just need to loop through a row, meet the criteria, then loop through columns, meet the criteria, then start again on next row to the end.


Thanks in advance!


Code:
Sub ChangeCellColor()
Dim c As Range




For Each c In Selection
    c.FormatConditions.Add Type:=xlCellValue, Operator:=xlGreater, Formula1:="=$B3"
        If Right(c.Value, 1) <> "U" Then
            With c.FormatConditions(1)
                .Interior.PatternColorIndex = xlAutomatic
                .Interior.Color = RGB(197, 217, 241)
                .Font.ColorIndex = 1
            End With
        End If
Next c


End Sub
 

Some videos you may like

Excel Facts

Waterfall charts in Excel?
Office 365 customers have access to Waterfall charts since late 2016. They were added to Excel 2019.

seattletimebandit

Board Regular
Joined
Apr 11, 2013
Messages
69
Here is a small portion of the table I'm working with to help with visualizing. The laboratory data with "U's" are non-detect for the compounds analyzed. The
bold numbers are results above the lab's detection limits, the Cleanup Levels in column B are the cells I need to find in the loop then
move across the row to check each cell, compare to the Cleanup Level, and highlight any cells that are greater than or equal to the
Cleanup Level (I couldn't fill the cells in this post, but most of the cells in Row 16 would be filled). Note there are some empty cells that need to be skipped in both Column B, and some in the rows (in this case Cols F and G).

If you paste this table into Excel, select any row and run the macro I posted, cells with data above "100" will be fill with a light blue color.

MW-01DMW-01DMW-02DMW-02DMW-03DMW-03DMW-04DMW-04D
CONSTITUENTCleanupLevel4/11/201110/18/20114/11/201110/19/20114/13/201110/17/20114/14/201110/17/2011
Dichlorodifluoromethane1001 U1.00 U1 U1.00 U1 U1.00 U1 U1.00 U
Chloromethane0.5 U0.500 U0.5 U0.500 U0.5 U0.500 U0.5 U0.500 U
Vinyl chloride1000.2 U0.2 U3.231.124.623.590.671.1
Bromomethane0.5 U0.5 U0.500 U0.500 U0.500 U0.500 U
Trichlorofluoromethane0.5 U0.5 U0.500 U0.500 U0.500 U0.500 U
Chloroethane0.910.5 U0.5 U0.500 U0.520.500 U0.500 U0.500 U
1,1-Dichloroethene100017.20.9812.34.2416.812.30.863.46
Acetone2 U2 U2 U2.00 U2.00 U2.00 U2.00 U2.00 U
Methylene chloride253.680.862.840.642.491.840.500 U0.6
trans-1,2-Dichloroethene18464.912461.312511161.760.2
1,1-Dichloroethane2757.0816455.32631745.8750.8
2,2-Dichloropropane1 U1 U1 U1.00 U1.00 U1.00 U1.00 U1.00 U
cis-1,2-Dichloroethene1100270010922008622480186090.8703
Chloroform1 U1 U1 U1.00 U1.00 U1.00 U1.00 U1.00 U

<tbody>
</tbody>
 
Last edited:

mumps

Well-known Member
Joined
Apr 11, 2012
Messages
10,181
Try:
Code:
Sub Test()
    Application.ScreenUpdating = False
    Dim lastColumn As Integer
    Dim c1 As Range
    Dim c2 As Range
    For Each c1 In Range("B3:B100")
        If c1 <> "" And IsNumeric(c1) Then
        lastColumn = ActiveSheet.Cells(c1.Row, Columns.Count).End(xlToLeft).Column
            For Each c2 In Range(Cells(c1.Row, 3), Cells(c1.Row, lastColumn))
                If c2 <> "" And IsNumeric(c2) And c2 >= c1 Then
                    c2.Interior.ColorIndex = 3
                End If
            Next c2
        End If
    Next c1
    Application.ScreenUpdating = True
End Sub
 

seattletimebandit

Board Regular
Joined
Apr 11, 2013
Messages
69
Mumps! You rock!

Most excellent Sir (or Madam)!

First run through it seemed to work as requested. Huge help! I knew I was close, but the nested For Loops were throwing me for a loop...(pun intended).

Much appreciated. That little snippet will come in hand in so many similar applications.
 

Watch MrExcel Video

Forum statistics

Threads
1,123,526
Messages
5,602,181
Members
414,510
Latest member
mande358

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top