VBA Loop instead of Conditional Formatting

excelnoob001

New Member
Joined
Jul 24, 2019
Messages
26
I am completely stuck on this one.

I have twenty seven columns I wish to format, however I feel conditional formatting might slow down my workbook.

There are three columns per sheet, with a total of nine sheets. They all start in the same range (C7 to E-whatever).

For each column, I wish to have a comparison that would check whether or not that cell is 3x greater than the cell below it, or if the cell below is 3x greater than the active cell. (In this beginning it's C7)

If either of those comparisons are true, highlight the text 1 and 2 units to the left of the active cell and the cell below to purple.

Rich (BB code):
Public Sub errorCheck3() 


    Dim firstIndex, secondIndex As Integer
    Dim firstCell, secondCell As Range
    firstIndex = 7
    secondIndex = 8
    Set firstCell = Range("C" & firstIndex) 'C7
    Set secondCell = Range("C" & secondIndex) 'C8
        
    Application.Calculation = xlCalculationManual
    
    While firstCell <> "" And secondCell <> "" 'while neither cells r blank
        
        Set firstCell = Range("C" & firstIndex)
        Set secondCell = Range("C" & secondIndex)
    
        If firstCell / secondCell >= 3 Then 'if first cell is 3 times greater than second cell
            firstCell.Offset(0, 2).Font.Color = vbPurple
            firstCell.Offset(0, 1).Font.Color = vbPurple
            firstCell.Offset(1, 2).Font.Color = vbPurple
            firstCell.Offset(1, 1).Font.Color = vbPurple
            
        ElseIf secondCell / firstCell >= 3 Then 'if second cell is 3 times greater than first cell
            firstCell.Offset(0, 2).Font.Color = vbPurple
            firstCell.Offset(0, 1).Font.Color = vbPurple
            firstCell.Offset(1, 2).Font.Color = vbPurple
            firstCell.Offset(1, 1).Font.Color = vbPurple
        
        End If
        
    firstIndex = firstIndex + 2 'C6 now is C8
    secondIndex = secondIndex + 2 'C7 is now C9
    
    Wend
    
    Application.Calculation = xlCalculationAutomatic
    
    MsgBox "Error Checking Successful."
End Sub

Any help or insight is greatly appreciated.
Thank you.
 
Last edited:

Excel Facts

Square and cube roots
The =SQRT(25) is a square root. For a cube root, use =125^(1/3). For a fourth root, use =625^(1/4).
Try this

Code:
Sub CF_Purplue()
  Dim c As Range, r As Range
  Set r = Range("C7", Range("C" & Rows.Count).End(xlUp))
  r.Offset(, 1).Resize(r.Count, 2).Font.Color = vbBlack
  On Error Resume Next
  For Each c In r
    If c / c.Offset(1) >= 3 Or c.Offset(1) / c >= 3 Then c.Offset(, 1).Resize(2, 2).Font.Color = vbPurple
  Next
End Sub
 
Upvote 0
Hi DanteAmor,

The code doesn't work when I put in dummy data. When I removed On Error Resume Next, I got division of zero error by
If c / c.Offset(1) >= 3 Or c.Offset(1) / c >= 3 Then c.Offset(, 1).Resize(2, 2).Font.Color = vbPurple
However,

Instead of having the text to the left of the cells as purple, can you make it so that the cell itself and the cell below it become highlighted with color peach?

Thank you!
 
Upvote 0
My test data before the macro:

<table border="1" cellspacing="0" style="font-family:Calibri,Arial; font-size:11pt; background-color:#ffffff; "> <colgroup><col style="font-weight:bold; width:30px; " /><col style="width:76.04px;" /><col style="width:76.04px;" /><col style="width:76.04px;" /></colgroup><tr style="background-color:#cacaca; text-align:center; font-weight:bold; font-size:8pt; "><td > </td><td >C</td><td >D</td><td >E</td></tr><tr style="height:19px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >7</td><td style="text-align:right; ">1</td><td >d7</td><td >e7</td></tr><tr style="height:19px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >8</td><td style="text-align:right; ">4</td><td >d8</td><td >e8</td></tr><tr style="height:19px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >9</td><td style="text-align:right; ">8</td><td >d9</td><td >e9</td></tr><tr style="height:19px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >10</td><td style="text-align:right; ">10</td><td >d10</td><td >e10</td></tr><tr style="height:19px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >11</td><td style="text-align:right; ">31</td><td >d11</td><td >e11</td></tr><tr style="height:19px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >12</td><td style="text-align:right; ">32</td><td >d12</td><td >e12</td></tr><tr style="height:19px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >13</td><td style="text-align:right; ">33</td><td >d13</td><td >e13</td></tr><tr style="height:19px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >14</td><td style="text-align:right; ">34</td><td >d14</td><td >e14</td></tr><tr style="height:19px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >15</td><td style="text-align:right; ">15</td><td >d12</td><td >e12</td></tr><tr style="height:19px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >16</td><td style="text-align:right; ">2</td><td >d13</td><td >e13</td></tr></table>

My test data after the macro:

<table border="1" cellspacing="0" style="font-family:Calibri,Arial; font-size:11pt; background-color:#ffffff; "> <colgroup><col style="font-weight:bold; width:30px; " /><col style="width:76.04px;" /><col style="width:76.04px;" /><col style="width:76.04px;" /></colgroup><tr style="background-color:#cacaca; text-align:center; font-weight:bold; font-size:8pt; "><td > </td><td >C</td><td >D</td><td >E</td></tr><tr style="height:19px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >7</td><td style="text-align:right; ">1</td><td style="color:#ff0000; ">d7</td><td style="color:#ff0000; ">e7</td></tr><tr style="height:19px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >8</td><td style="text-align:right; ">4</td><td style="color:#ff0000; ">d8</td><td style="color:#ff0000; ">e8</td></tr><tr style="height:19px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >9</td><td style="text-align:right; ">8</td><td >d9</td><td >e9</td></tr><tr style="height:19px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >10</td><td style="text-align:right; ">10</td><td style="color:#ff0000; ">d10</td><td style="color:#ff0000; ">e10</td></tr><tr style="height:19px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >11</td><td style="text-align:right; ">31</td><td style="color:#ff0000; ">d11</td><td style="color:#ff0000; ">e11</td></tr><tr style="height:19px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >12</td><td style="text-align:right; ">32</td><td >d12</td><td >e12</td></tr><tr style="height:19px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >13</td><td style="text-align:right; ">33</td><td >d13</td><td >e13</td></tr><tr style="height:19px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >14</td><td style="text-align:right; ">34</td><td >d14</td><td >e14</td></tr><tr style="height:19px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >15</td><td style="text-align:right; ">15</td><td style="color:#ff0000; ">d12</td><td style="color:#ff0000; ">e12</td></tr><tr style="height:19px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >16</td><td style="text-align:right; ">2</td><td style="color:#ff0000; ">d13</td><td style="color:#ff0000; ">e13</td></tr></table>


-------------------------------------------------------------
What is your dummy data and what is the result you expect?
 
Upvote 0
I am going down the column in pairs and checking the numbers.

Going off of your table above, the macro would first start at C7. It would check whether or not 1 or 4 is greater than the other 3x. It is, so it would highlight 1 and 4 as color peach.
The next pair would be 8 and 10, neither are greater than each other by 3x, therefore nothing happens.
The next pair would be 31 and 32, neither are greater than each other by 3x, therefore nothing happens.

This would happen until it reaches the bottom of the column.
 
Upvote 0
I am going down the column in pairs and checking the numbers.

Going off of your table above, the macro would first start at C7. It would check whether or not 1 or 4 is greater than the other 3x. It is, so it would highlight 1 and 4 as color peach.
The next pair would be 8 and 10, neither are greater than each other by 3x, therefore nothing happens.
The next pair would be 31 and 32, neither are greater than each other by 3x, therefore nothing happens.

This would happen until it reaches the bottom of the column.


Please Note
-----------------------
One thing you must keep in mind when you ask a question in a forum... the people you are asking to help you know absolutely nothing about your data, absolutely nothing about how it is laid out in the workbook, absolutely nothing about what you want done with it and absolutely nothing about how whatever it is you want done is to be presented back to you as a result... you must be very specific about describing each of these areas, in detail, and you should not assume that we will be able to "figure it out" on our own. Remember, you are asking us for help... so help us to be able to help you by providing the information we need to do so, even if that information seems "obvious" to you (remember, it is only obvious to you because of your familiarity with your data, its layout and the overall objective for it).


-----------------------



Again: What is your dummy data and what is the result you expect?
 
Upvote 0
Try this.

Code:
Sub CF_Purplue()
  Dim c As Range, r As Range, i as long
  Set r = Range("C7", Range("C" & Rows.Count).End(xlUp))
  r.Offset(, 1).Resize(r.Count, 2).Font.Color = vbBlack
  On Error Resume Next
  For i = 7 to Range("C" & Rows.Count).End(xlUp).row step 2
    Set c = cells(i, "C")
    If c / c.Offset(1) >= 3 Or c.Offset(1) / c >= 3 Then c.Offset(, 1).Resize(2, 2).Font.Color = vbPurple
  Next
End Sub
 
Upvote 0
Hi DanteAmor,

Sorry if I wasn't being clear. I got to work by editing a few parts of your sub, so it was great that I had something to go off of.

Thanks!
 
Upvote 0

Forum statistics

Threads
1,214,929
Messages
6,122,315
Members
449,081
Latest member
tanurai

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
Back
Top