Converting Conditional Formatting to VBA

[Joeclupis]

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

	A	B	C	D	E	F	G	H	I	J	K	L
2	Hangar Address	Location	Owner/ Renter	Commercial?	Pass	Fail	Insurance exp	Address	Email	Phone	Insurance Failure?	Number of Aircraft
3	1690 Aeronca Lane	North		YES			9/26/2018					0
4												0
5	300 Airport Road	North		YES			12/31/2017					0

<tbody>
</tbody>

All Hangars Table​

Worksheet Formulas Cell Formula K3 =IF([COLOR=rgb(255]G3<now(), "insurance",""[="" color])<="" td=""></now(),> L3 =COUNTA([COLOR=rgb(255]N3:AB3[/COLOR]) L4 =COUNTA([COLOR=rgb(255]N4:AB4[/COLOR]) K5 =IF([COLOR=rgb(255]G5<now(),"insurance",""[ color])<="" td=""></now(),"insurance",""[> L5 =COUNTA([COLOR=rgb(255]N5:AB5[/COLOR]) <tbody> </tbody>

<tbody>
</tbody>

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

 

[HotRhodium]

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.

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

 

[Joeclupis]

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

 

[Joeclupis]

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