otergutt
03-31-2017, 01:03 AM
I've made a VBA routine to apply conditional color formatting to cells containing analysis results for various pollutants based on pollution classes. This is no problem for only a couple of pollutants, but when I need to do the same thing for 45 different pollutants, the code will bloat to unmanageable proportions. To make matters a little difficult, the file has a header which puts the column headers in row 7.
Below is the working code for 2 out of 45 elements.
'As (This is the pollutant element)
'Finds the header with the correct name and defines the range as extending from this heading and down to the first empty cell
Set rngHeaderAs = Range("A1:ZZ200").Find("As*Arsen", lookat:=xlPart) 'Finds column header
Set rngAs = Range(rngHeaderAs, rngHeaderAs.End(xlDown)) 'Sets the range for the element to be formatted with rules
AsAddress = rngHeaderAs.Address(False, False) 'Gets the starting cell address for the range, to be used in the formula
'Sets the limit values for the elements
Dim Ul1As As Double
Ul1As = 8
Dim Ul2As As Double
Ul2As = 20
Dim Ul3As As Double
Ul3As = 50
Dim Ul4As As Double
Ul4As = 600
Dim Ul5As As Double
Ul5As = 1000
'Applies the formatting
With ActiveSheet
With rngAs
.FormatConditions.Add xlExpression, Formula1:="=AND(ISNUMBER(" & AsAddress & ");" & AsAddress & "<" & Ul1As & ")"
.FormatConditions(1).Interior.ColorIndex = 33
.FormatConditions(1).Borders.LineStyle = xlContinuous
.FormatConditions(1).Borders.Weight = xlThin
'.FormatConditions(1).Font.Bold = True
'.FormatConditions(1).Font.ColorIndex = 6
End With
With rngAs
.FormatConditions.Add xlExpression, Formula1:="=AND(ISNUMBER(" & AsAddress & ");" & AsAddress & ">=" & Ul1As & ";" & AsAddress & "<" & Ul2As & ")"
.FormatConditions(2).Interior.ColorIndex = 4
.FormatConditions(2).Borders.LineStyle = xlContinuous
.FormatConditions(2).Borders.Weight = xlThin
End With
With rngAs
.FormatConditions.Add xlExpression, Formula1:="=AND(ISNUMBER(" & AsAddress & ");" & AsAddress & ">=" & Ul2As & ";" & AsAddress & "<" & Ul3As & ")"
.FormatConditions(3).Interior.ColorIndex = 6
.FormatConditions(3).Borders.LineStyle = xlContinuous
.FormatConditions(3).Borders.Weight = xlThin
End With
With rngAs
.FormatConditions.Add xlExpression, Formula1:="=AND(ISNUMBER(" & AsAddress & ");" & AsAddress & ">=" & Ul3As & ";" & AsAddress & "<" & Ul4As & ")"
.FormatConditions(4).Interior.ColorIndex = 45
.FormatConditions(4).Borders.LineStyle = xlContinuous
.FormatConditions(4).Borders.Weight = xlThin
End With
With rngAs
.FormatConditions.Add xlExpression, Formula1:="=AND(ISNUMBER(" & AsAddress & ");" & AsAddress & ">=" & Ul4As & ";" & AsAddress & "<" & Ul5As & ")"
.FormatConditions(5).Borders.LineStyle = xlContinuous
.FormatConditions(5).Borders.Weight = xlThin
.FormatConditions(5).Interior.ColorIndex = 3
End With
With rngAs
.FormatConditions.Add xlExpression, Formula1:="=AND(ISNUMBER(" & AsAddress & ");" & AsAddress & ">=" & Ul5As & ")"
.FormatConditions(6).Interior.ColorIndex = 7
.FormatConditions(6).Borders.LineStyle = xlContinuous
.FormatConditions(6).Borders.Weight = xlThin
End With
With rngAs
.FormatConditions.Add xlExpression, Formula1:="=LEFT(" & AsAddress & ";1)=""<"""
.FormatConditions(7).Interior.ColorIndex = 33
.FormatConditions(7).Borders.LineStyle = xlContinuous
.FormatConditions(7).Borders.Weight = xlThin
End With
With rngAs
.FormatConditions.Add xlExpression, Formula1:="=(" & AsAddress & ") = ""n.d."""
.FormatConditions(8).Interior.ColorIndex = 33
.FormatConditions(8).Borders.LineStyle = xlContinuous
.FormatConditions(8).Borders.Weight = xlThin
End With
End With
'Cd
Set rngHeaderCd = Range("A1:ZZ200").Find("Cd*Kadmium", lookat:=xlPart)
Set rngCd = Range(rngHeaderCd, rngHeaderCd.End(xlDown))
CdAddress = rngHeaderCd.Address(False, False)
Dim Ul1Cd As Double
Ul1Cd = 1.5
Dim Ul2Cd As Double
Ul2Cd = 10
Dim Ul3Cd As Double
Ul3Cd = 15
Dim Ul4Cd As Double
Ul4Cd = 30
Dim Ul5Cd As Double
Ul5Cd = 1000
With ActiveSheet
With rngCd
.FormatConditions.Add xlExpression, Formula1:="=AND(ISNUMBER(" & CdAddress & ");" & CdAddress & "<" & Ul1Cd & ")"
.FormatConditions(1).Interior.ColorIndex = 33
.FormatConditions(1).Borders.LineStyle = xlContinuous
.FormatConditions(1).Borders.Weight = xlThin
End With
With rngCd
.FormatConditions.Add xlExpression, Formula1:="=AND(ISNUMBER(" & CdAddress & ");" & CdAddress & ">=" & Ul1Cd & ";" & CdAddress & "<" & Ul2Cd & ")"
.FormatConditions(2).Interior.ColorIndex = 4
.FormatConditions(2).Borders.LineStyle = xlContinuous
.FormatConditions(2).Borders.Weight = xlThin
End With
With rngCd
.FormatConditions.Add xlExpression, Formula1:="=AND(ISNUMBER(" & CdAddress & ");" & CdAddress & ">=" & Ul2Cd & ";" & CdAddress & "<" & Ul3Cd & ")"
.FormatConditions(3).Interior.ColorIndex = 6
.FormatConditions(3).Borders.LineStyle = xlContinuous
.FormatConditions(3).Borders.Weight = xlThin
End With
With rngCd
.FormatConditions.Add xlExpression, Formula1:="=AND(ISNUMBER(" & CdAddress & ");" & CdAddress & ">=" & Ul3Cd & ";" & CdAddress & "<" & Ul4Cd & ")"
.FormatConditions(4).Interior.ColorIndex = 45
.FormatConditions(4).Borders.LineStyle = xlContinuous
.FormatConditions(4).Borders.Weight = xlThin
End With
With rngCd
.FormatConditions.Add xlExpression, Formula1:="=AND(ISNUMBER(" & CdAddress & ");" & CdAddress & ">=" & Ul4Cd & ";" & CdAddress & "<" & Ul5Cd & ")"
.FormatConditions(5).Interior.ColorIndex = 3
.FormatConditions(5).Borders.LineStyle = xlContinuous
.FormatConditions(5).Borders.Weight = xlThin
End With
With rngCd
.FormatConditions.Add xlExpression, Formula1:="=AND(ISNUMBER(" & CdAddress & ");" & CdAddress & ">=" & Ul5Cd & ")"
.FormatConditions(6).Interior.ColorIndex = 7
.FormatConditions(6).Borders.LineStyle = xlContinuous
.FormatConditions(6).Borders.Weight = xlThin
End With
With rngCd
.FormatConditions.Add xlExpression, Formula1:="=LEFT(" & CdAddress & ";1)=""<"""
.FormatConditions(7).Interior.ColorIndex = 33
.FormatConditions(7).Borders.LineStyle = xlContinuous
.FormatConditions(7).Borders.Weight = xlThin
End With
With rngCd
.FormatConditions.Add xlExpression, Formula1:="=(" & CdAddress & ") = ""n.d."""
.FormatConditions(8).Interior.ColorIndex = 33
.FormatConditions(8).Borders.LineStyle = xlContinuous
.FormatConditions(8).Borders.Weight = xlThin
End With
End With
'and so on for upwards of 45 different pollutants
End Sub
I suspect that an array/select case approach would be much more apppropriate, but I don't know how to work that into my range selection method. I'm attaching a sample analysis file so you can see how it is supposed to work.
Hope anyone can help me.
18812
Edit: I replaced referenced values in the limits with fixed ones
Below is the working code for 2 out of 45 elements.
'As (This is the pollutant element)
'Finds the header with the correct name and defines the range as extending from this heading and down to the first empty cell
Set rngHeaderAs = Range("A1:ZZ200").Find("As*Arsen", lookat:=xlPart) 'Finds column header
Set rngAs = Range(rngHeaderAs, rngHeaderAs.End(xlDown)) 'Sets the range for the element to be formatted with rules
AsAddress = rngHeaderAs.Address(False, False) 'Gets the starting cell address for the range, to be used in the formula
'Sets the limit values for the elements
Dim Ul1As As Double
Ul1As = 8
Dim Ul2As As Double
Ul2As = 20
Dim Ul3As As Double
Ul3As = 50
Dim Ul4As As Double
Ul4As = 600
Dim Ul5As As Double
Ul5As = 1000
'Applies the formatting
With ActiveSheet
With rngAs
.FormatConditions.Add xlExpression, Formula1:="=AND(ISNUMBER(" & AsAddress & ");" & AsAddress & "<" & Ul1As & ")"
.FormatConditions(1).Interior.ColorIndex = 33
.FormatConditions(1).Borders.LineStyle = xlContinuous
.FormatConditions(1).Borders.Weight = xlThin
'.FormatConditions(1).Font.Bold = True
'.FormatConditions(1).Font.ColorIndex = 6
End With
With rngAs
.FormatConditions.Add xlExpression, Formula1:="=AND(ISNUMBER(" & AsAddress & ");" & AsAddress & ">=" & Ul1As & ";" & AsAddress & "<" & Ul2As & ")"
.FormatConditions(2).Interior.ColorIndex = 4
.FormatConditions(2).Borders.LineStyle = xlContinuous
.FormatConditions(2).Borders.Weight = xlThin
End With
With rngAs
.FormatConditions.Add xlExpression, Formula1:="=AND(ISNUMBER(" & AsAddress & ");" & AsAddress & ">=" & Ul2As & ";" & AsAddress & "<" & Ul3As & ")"
.FormatConditions(3).Interior.ColorIndex = 6
.FormatConditions(3).Borders.LineStyle = xlContinuous
.FormatConditions(3).Borders.Weight = xlThin
End With
With rngAs
.FormatConditions.Add xlExpression, Formula1:="=AND(ISNUMBER(" & AsAddress & ");" & AsAddress & ">=" & Ul3As & ";" & AsAddress & "<" & Ul4As & ")"
.FormatConditions(4).Interior.ColorIndex = 45
.FormatConditions(4).Borders.LineStyle = xlContinuous
.FormatConditions(4).Borders.Weight = xlThin
End With
With rngAs
.FormatConditions.Add xlExpression, Formula1:="=AND(ISNUMBER(" & AsAddress & ");" & AsAddress & ">=" & Ul4As & ";" & AsAddress & "<" & Ul5As & ")"
.FormatConditions(5).Borders.LineStyle = xlContinuous
.FormatConditions(5).Borders.Weight = xlThin
.FormatConditions(5).Interior.ColorIndex = 3
End With
With rngAs
.FormatConditions.Add xlExpression, Formula1:="=AND(ISNUMBER(" & AsAddress & ");" & AsAddress & ">=" & Ul5As & ")"
.FormatConditions(6).Interior.ColorIndex = 7
.FormatConditions(6).Borders.LineStyle = xlContinuous
.FormatConditions(6).Borders.Weight = xlThin
End With
With rngAs
.FormatConditions.Add xlExpression, Formula1:="=LEFT(" & AsAddress & ";1)=""<"""
.FormatConditions(7).Interior.ColorIndex = 33
.FormatConditions(7).Borders.LineStyle = xlContinuous
.FormatConditions(7).Borders.Weight = xlThin
End With
With rngAs
.FormatConditions.Add xlExpression, Formula1:="=(" & AsAddress & ") = ""n.d."""
.FormatConditions(8).Interior.ColorIndex = 33
.FormatConditions(8).Borders.LineStyle = xlContinuous
.FormatConditions(8).Borders.Weight = xlThin
End With
End With
'Cd
Set rngHeaderCd = Range("A1:ZZ200").Find("Cd*Kadmium", lookat:=xlPart)
Set rngCd = Range(rngHeaderCd, rngHeaderCd.End(xlDown))
CdAddress = rngHeaderCd.Address(False, False)
Dim Ul1Cd As Double
Ul1Cd = 1.5
Dim Ul2Cd As Double
Ul2Cd = 10
Dim Ul3Cd As Double
Ul3Cd = 15
Dim Ul4Cd As Double
Ul4Cd = 30
Dim Ul5Cd As Double
Ul5Cd = 1000
With ActiveSheet
With rngCd
.FormatConditions.Add xlExpression, Formula1:="=AND(ISNUMBER(" & CdAddress & ");" & CdAddress & "<" & Ul1Cd & ")"
.FormatConditions(1).Interior.ColorIndex = 33
.FormatConditions(1).Borders.LineStyle = xlContinuous
.FormatConditions(1).Borders.Weight = xlThin
End With
With rngCd
.FormatConditions.Add xlExpression, Formula1:="=AND(ISNUMBER(" & CdAddress & ");" & CdAddress & ">=" & Ul1Cd & ";" & CdAddress & "<" & Ul2Cd & ")"
.FormatConditions(2).Interior.ColorIndex = 4
.FormatConditions(2).Borders.LineStyle = xlContinuous
.FormatConditions(2).Borders.Weight = xlThin
End With
With rngCd
.FormatConditions.Add xlExpression, Formula1:="=AND(ISNUMBER(" & CdAddress & ");" & CdAddress & ">=" & Ul2Cd & ";" & CdAddress & "<" & Ul3Cd & ")"
.FormatConditions(3).Interior.ColorIndex = 6
.FormatConditions(3).Borders.LineStyle = xlContinuous
.FormatConditions(3).Borders.Weight = xlThin
End With
With rngCd
.FormatConditions.Add xlExpression, Formula1:="=AND(ISNUMBER(" & CdAddress & ");" & CdAddress & ">=" & Ul3Cd & ";" & CdAddress & "<" & Ul4Cd & ")"
.FormatConditions(4).Interior.ColorIndex = 45
.FormatConditions(4).Borders.LineStyle = xlContinuous
.FormatConditions(4).Borders.Weight = xlThin
End With
With rngCd
.FormatConditions.Add xlExpression, Formula1:="=AND(ISNUMBER(" & CdAddress & ");" & CdAddress & ">=" & Ul4Cd & ";" & CdAddress & "<" & Ul5Cd & ")"
.FormatConditions(5).Interior.ColorIndex = 3
.FormatConditions(5).Borders.LineStyle = xlContinuous
.FormatConditions(5).Borders.Weight = xlThin
End With
With rngCd
.FormatConditions.Add xlExpression, Formula1:="=AND(ISNUMBER(" & CdAddress & ");" & CdAddress & ">=" & Ul5Cd & ")"
.FormatConditions(6).Interior.ColorIndex = 7
.FormatConditions(6).Borders.LineStyle = xlContinuous
.FormatConditions(6).Borders.Weight = xlThin
End With
With rngCd
.FormatConditions.Add xlExpression, Formula1:="=LEFT(" & CdAddress & ";1)=""<"""
.FormatConditions(7).Interior.ColorIndex = 33
.FormatConditions(7).Borders.LineStyle = xlContinuous
.FormatConditions(7).Borders.Weight = xlThin
End With
With rngCd
.FormatConditions.Add xlExpression, Formula1:="=(" & CdAddress & ") = ""n.d."""
.FormatConditions(8).Interior.ColorIndex = 33
.FormatConditions(8).Borders.LineStyle = xlContinuous
.FormatConditions(8).Borders.Weight = xlThin
End With
End With
'and so on for upwards of 45 different pollutants
End Sub
I suspect that an array/select case approach would be much more apppropriate, but I don't know how to work that into my range selection method. I'm attaching a sample analysis file so you can see how it is supposed to work.
Hope anyone can help me.
18812
Edit: I replaced referenced values in the limits with fixed ones