Converting Conditional Formatting to VBA

Joeclupis

Board Regular
Joined
Jun 18, 2016
Messages
63
Hello everyone,

I have a spreadsheet that we used to track inspections at our airport. I did not create the spreadsheet. I am attaching a snippet of it so that you can get a idea what I am trying to do.

Excel 2016 (Windows) 32 bit
ABCDEFGHIJKL
EmailPhone

<tbody>
[TD="align: center"]2[/TD]
[TD="align: center"]Hangar Address[/TD]
[TD="align: center"]Location[/TD]
[TD="align: center"]Owner/ Renter[/TD]
[TD="align: center"]Commercial?[/TD]
[TD="align: center"]Pass[/TD]
[TD="align: center"]Fail[/TD]
[TD="align: center"]Insurance exp[/TD]
[TD="align: center"]Address[/TD]

[TD="align: center"]Insurance Failure?[/TD]
[TD="align: center"]Number of Aircraft[/TD]

[TD="align: center"]3[/TD]
[TD="align: center"]1690 Aeronca Lane[/TD]
[TD="align: center"]North[/TD]
[TD="align: center"][/TD]
[TD="align: center"]YES[/TD]
[TD="bgcolor: [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=C4D79B]#C4D79B[/URL] , align: center"][/TD]
[TD="bgcolor: [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=DA9694]#DA9694[/URL] , align: center"][/TD]
[TD="align: center"]9/26/2018[/TD]

[TD="align: right"][/TD]

[TD="align: center"][/TD]
[TD="align: center"]0[/TD]

[TD="align: center"]4[/TD]
[TD="bgcolor: [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=BFBFBF]#BFBFBF[/URL] , align: center"][/TD]
[TD="bgcolor: [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=BFBFBF]#BFBFBF[/URL] , align: center"][/TD]
[TD="bgcolor: [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=BFBFBF]#BFBFBF[/URL] , align: center"][/TD]
[TD="bgcolor: [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=BFBFBF]#BFBFBF[/URL] , align: center"][/TD]
[TD="bgcolor: [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=BFBFBF]#BFBFBF[/URL] , align: center"][/TD]
[TD="bgcolor: [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=BFBFBF]#BFBFBF[/URL] , align: center"][/TD]
[TD="bgcolor: [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=BFBFBF]#BFBFBF[/URL] , align: center"][/TD]
[TD="bgcolor: [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=BFBFBF]#BFBFBF[/URL] "][/TD]
[TD="bgcolor: [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=BFBFBF]#BFBFBF[/URL] , align: right"][/TD]
[TD="bgcolor: [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=BFBFBF]#BFBFBF[/URL] "][/TD]
[TD="bgcolor: [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=BFBFBF]#BFBFBF[/URL] , align: center"][/TD]
[TD="bgcolor: [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=BFBFBF]#BFBFBF[/URL] , align: center"]0[/TD]

[TD="align: center"]5[/TD]
[TD="align: center"]300 Airport Road[/TD]
[TD="align: center"]North[/TD]
[TD="align: center"][/TD]
[TD="align: center"]YES[/TD]
[TD="bgcolor: [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=C4D79B]#C4D79B[/URL] , align: center"][/TD]
[TD="bgcolor: [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=DA9694]#DA9694[/URL] , align: center"][/TD]
[TD="align: center"]12/31/2017[/TD]

[TD="align: right"][/TD]

[TD="align: center"][/TD]
[TD="align: center"]0[/TD]

</tbody>
All Hangars Table

[TABLE="width: 85%"]
<tbody>[TR]
[TD]Worksheet Formulas[TABLE="width: 100%"]
<tbody>[TR="bgcolor: [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=F0E0E0]#F0E0E0[/URL] "]
[TH]Cell[/TH]
[TH="align: left"]Formula[/TH]
[/TR]
[TR]
[TH="bgcolor: [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=F0E0E0]#F0E0E0[/URL] "]K3[/TH]
[TD="align: left"]=IF([COLOR=rgb(255]G3<now(), "insurance",""[="" color])<="" td=""></now(),>[/TD]
[/TR]
[TR]
[TH="bgcolor: [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=F0E0E0]#F0E0E0[/URL] "]L3[/TH]
[TD="align: left"]=COUNTA([COLOR=rgb(255]N3:AB3[/COLOR])[/TD]
[/TR]
[TR]
[TH="bgcolor: [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=F0E0E0]#F0E0E0[/URL] "]L4[/TH]
[TD="align: left"]=COUNTA([COLOR=rgb(255]N4:AB4[/COLOR])[/TD]
[/TR]
[TR]
[TH="bgcolor: [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=F0E0E0]#F0E0E0[/URL] "]K5[/TH]
[TD="align: left"]=IF([COLOR=rgb(255]G5<now(),"insurance",""[ color])<="" td=""></now(),"insurance",""[>[/TD]
[/TR]
[TR]
[TH="bgcolor: [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=F0E0E0]#F0E0E0[/URL] "]L5[/TH]
[TD="align: left"]=COUNTA([COLOR=rgb(255]N5:AB5[/COLOR])[/TD]
[/TR]
</tbody>[/TABLE]
[/TD]
[/TR]
</tbody>[/TABLE]



In the columns "Pass", "Fail", and "Insurance" we are capturing the specific dates that the hangars were inspected and whether they Passed or Failed. Insurance in input throughout the year. What is supposed to happen is when a hangar passes, the entire row from A to L is to turn green. If it fails, then the row is to turn red. If the Insurance exp cell in the row (column G) is out of date, the cell in the row for Insurance Failure? (column K) is supposed to turn red and have the word "INSURANCE" in white text and the cell in column G is supposed to turn red.

I have found that when i insert a row, the formatting does not follow thru. I tried to create conditional formatting for the new rows that was the same as the other rows, but it didn't work. I would like to take the conditional formatting and convert it to VBA Code so that inserting rows doesn't become an issue for others. The worksheet currently has some VBA Code, but I cannot truly follow it.

The VBA Code is:
Function GetCellColor(xlRange As Range)
Dim indRow, indColumn As Long
Dim arResults()

Application.Volatile

If xlRange Is Nothing Then
Set xlRange = Application.ThisCell
End If

If xlRange.Count > 1 Then
ReDim arResults(1 To xlRange.Rows.Count, 1 To xlRange.Columns.Count)
For indRow = 1 To xlRange.Rows.Count
For indColumn = 1 To xlRange.Columns.Count
arResults(indRow, indColumn) = xlRange(indRow, indColumn).Interior.Color
Next
Next
GetCellColor = arResults
Else
GetCellColor = xlRange.Interior.Color
End If
End Function

Function GetCellFontColor(xlRange As Range)
Dim indRow, indColumn As Long
Dim arResults()

Application.Volatile

If xlRange Is Nothing Then
Set xlRange = Application.ThisCell
End If

If xlRange.Count > 1 Then
ReDim arResults(1 To xlRange.Rows.Count, 1 To xlRange.Columns.Count)
For indRow = 1 To xlRange.Rows.Count
For indColumn = 1 To xlRange.Columns.Count
arResults(indRow, indColumn) = xlRange(indRow, indColumn).Font.Color
Next
Next
GetCellFontColor = arResults
Else
GetCellFontColor = xlRange.Font.Color
End If

End Function

Function CountCellsByColor(rData As Range, cellRefColor As Range) As Long
Dim indRefColor As Long
Dim cellCurrent As Range
Dim cntRes As Long

Application.Volatile
cntRes = 0
indRefColor = cellRefColor.Cells(1, 1).Interior.Color
For Each cellCurrent In rData
If indRefColor = cellCurrent.Interior.Color Then
cntRes = cntRes + 1
End If
Next cellCurrent

CountCellsByColor = cntRes
End Function

Function SumCellsByColor(rData As Range, cellRefColor As Range)
Dim indRefColor As Long
Dim cellCurrent As Range
Dim sumRes

Application.Volatile
sumRes = 0
indRefColor = cellRefColor.Cells(1, 1).Interior.Color
For Each cellCurrent In rData
If indRefColor = cellCurrent.Interior.Color Then
sumRes = WorksheetFunction.Sum(cellCurrent, sumRes)
End If
Next cellCurrent

SumCellsByColor = sumRes
End Function

Function CountCellsByFontColor(rData As Range, cellRefColor As Range) As Long
Dim indRefColor As Long
Dim cellCurrent As Range
Dim cntRes As Long

Application.Volatile
cntRes = 0
indRefColor = cellRefColor.Cells(1, 1).Font.Color
For Each cellCurrent In rData
If indRefColor = cellCurrent.Font.Color Then
cntRes = cntRes + 1
End If
Next cellCurrent

CountCellsByFontColor = cntRes
End Function

Function SumCellsByFontColor(rData As Range, cellRefColor As Range)
Dim indRefColor As Long
Dim cellCurrent As Range
Dim sumRes

Application.Volatile
sumRes = 0
indRefColor = cellRefColor.Cells(1, 1).Font.Color
For Each cellCurrent In rData
If indRefColor = cellCurrent.Font.Color Then
sumRes = WorksheetFunction.Sum(cellCurrent, sumRes)
End If
Next cellCurrent

SumCellsByFontColor = sumRes
End Function

Function CountCcolor(range_data As Range, criteria As Range) As Long
Dim datax As Range
Dim xcolor As Long
xcolor = criteria.Interior.ColorIndex
For Each datax In range_data
If datax.Interior.ColorIndex = xcolor Then
CountCcolor = CountCcolor + 1
End If
Next datax
End Function

Am I asking the impossible?

Thank you

Joseph Carney
Airport Operations Specialist
jcarney@sspmn.org
 

Excel Facts

Remove leading & trailing spaces
Save as CSV to remove all leading and trailing spaces. It is faster than using TRIM().
Ok so I think I am understanding that you want to keep the above code and just add your "VBA Formatting"? Ok so this will be very slow because of the volatile functions you have here. A better option would be a function that does the above functions and formats your cells in one go but that may be a larger project. In short if you are just trying to color your cells just loop through them setting the cellCurrent.Font.Color = to something, based on the criteria you want to use.

The next question is the vehicle you want to use for example you could use the Cell Change event and then check your cells.

For example something like this will turn your entire row red if the cell in col 1 says "Fail" and black if not. It will only act on the row you made a change in.

Code:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
 If Me.Cells(Target.Row, 1) = "Fail" Then
  Target.EntireRow.Font.Color = VBA.RGB(255, 0, 0)
 Else
  Target.EntireRow.Font.Color = VBA.RGB(0, 0, 0)
 End If
End Sub
 
Upvote 0
HotRhodium, Thank you for the code. Sad to say, I am not conversant in VBA Code, so I don't know what the code that I posted does. I inherited the spreadsheet. If the VBA code would be too sluggish or too involved, is there a way to have conditional formatting on the entire area of active data? I can do conditional formatting, but for some reason adding more conditional formatting to rows that I am inserting is not working.

Thank you
 
Upvote 0
Everyone,

I have solved this question. I ended up having to do Conditional Formatting on each row. Time consuming and very mind numbing, but I finished the project.

Thank you all
 
Upvote 0

Forum statistics

Threads
1,224,826
Messages
6,181,192
Members
453,021
Latest member
pingpong7117

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