PDA

View Full Version : [SOLVED] Conditional formatting of cells for 45 different cases with 5 criteria each



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

mdmackillop
03-31-2017, 06:21 AM
For information, I had to replace semi-colons in your code with commas to get it to compile.

offthelip
03-31-2017, 09:35 AM
I don't have time to write the code but there seems to be a very easy way:
define U11As,U12As,U13As etc as arrays


You will need to load the constants into each of these arrays, personnaly I would do this by loading the values from a spreadsheet.


then you can loop through you first set of code for 45 times just by changing your variable to indexed variables, obviously you need to Find text as an array as well.


As an example of a few lines



' initialise arrays
for i = 1 to 45




Set rngHeaderCd = Range("A1:ZZ200").Find(FINDTEXT(i), lookat:=xlPart)


.FormatConditions.Add xlExpression, Formula1:="=AND(ISNUMBER(" & CdAddress & ");" & CdAddress & "<" & Ul1Cd(i) & ")"
' etc'etc


next i

otergutt
04-01-2017, 11:06 PM
Thanks for the suggestion. However, I'm a complete newbie when it comes to arrays, so I can't get my head around how to define the arrays. I have the table of elements and values stored in a spreadsheet which is imported as a separate sheet to the workbook; I'm attaching it here. Could you give me an example on how I would define and populate the arrays?

Thanks again.

18825

mdmackillop
04-02-2017, 04:10 AM
Can you post you first csv as an excel file and show in a sample how the data should appear. Rows 7 & 8 need to be split into columns but what is the significance of ;<0? Can these be deleteted to simplify formatting? Column C-E show some cells with "double" entries. How is this to be handled?

otergutt
04-02-2017, 06:08 AM
Please find attached the report file saved as Excel in to versions: One version before (N1500972.xlsx) macro is run and one version after (N1500972_colored.xlsx) the macro is run), with the limit values in a separate worksheet (Grenseverdier_jord). The macro pulls the variables from this sheet. Also find attached the complete macro which colors the cells (Color_labreport.docx). The reason for the semicolons is that in Norway, we use comma as decimal separator, and therefore we use semicolons as delimiters in Excel formulas. I have replaced semicolons with commas.

1882918831

18832

I hope this helps you help me ;)

mdmackillop
04-02-2017, 09:30 AM
For your consideration

Grenseverdier_jord contains colour for each element/class. Colums are reordered to suit the Match function in the code. Change cells to your requirements; the button will save the colour to the array shown.

Edit sheet contains a copy of your data, stripped of "<" etc. to convert cells to numbers. These are compared to the G-j sheet and coloured accordingly (Note; numbers have been changed here for AS illustration purposes so appear wrong when copied to main sheet)

Colour formatting is copied from Edit to the main sheet.

otergutt
04-02-2017, 10:08 AM
Thanks so much. I will change limits and colors to my requirements, but this makes it much easier. Just one thing: How do you define the colors? I don't recognise the numbers as color identifiers.

otergutt
04-02-2017, 10:23 AM
Never mind, I just understood it ... ;)