PDA

View Full Version : [SOLVED:] Conditional Formatting on a table based on a different table VBA



jazz2409
05-09-2020, 08:15 PM
Hello, this question is also based here: http://www.vbaexpress.com/forum/showthread.php?67224-Creating-a-single-Table-with-different-formulas-Excel-VBA

But this time I just need to put conditional formatting.

So I have two tables:

26616

I need to put conditional formatting on the left table based on the right table. If a cell on the right table says P, the font color on the left table of the same row and date will be green. If it says F, it should be red.

The font size won't change, just to font colors.

Attached is my sample workbook. Thank you

Bob Phillips
05-10-2020, 02:13 AM
It is just a simple look across, Using a formula it would be, select all cells in table 1, and use

=R9="P"

and

=R9="F"

jazz2409
05-10-2020, 04:27 AM
Hello. this is what I have which I added at the end of your Public Function SetupSubcategoryRow(ByVal targetrow As Long, ByVal category As Variant, ByVal Subcategory As Variant) As Boolean
Dim matchidx As Long:


For k = 7 To 16
With tblSh.Cells(targetrow, k)


.FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, Formula1:="=R9=""P"""
.FormatConditions(.FormatConditions.Count).SetFirstPriority
.FormatConditions(.FormatConditions.Count).Font.Bold = True
.FormatConditions(.FormatConditions.Count).Font.Color = vbGreen


.FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, Formula1:="=R9=""F"""
.FormatConditions(.FormatConditions.Count).Font.Bold = True
.FormatConditions(.FormatConditions.Count).Font.Color = vbRed


End With
Next

I did the same for the Public Function SetupCategoryRow(ByVal targetrow As Long, ByVal category As Variant) As Boolean and it did work, I'm just nor sure why it wouldn't work with the subcategory function :banghead:

Bob Phillips
05-10-2020, 01:48 PM
Can you post your latest workbook, so we can see the real thing.

jazz2409
05-10-2020, 04:48 PM
Hello, here's a sample workbook. This is exactly the same as my original one, except the categories.

Bob Phillips
05-11-2020, 04:36 AM
Well the conditional formatting worked for me with subcategory as well as category.

But you do have a problem in that you need to clear all old CF when adding new, else they just get added to giving you too much CF (which is badly inefficient). Also you don't need ton setup a variable to the Table worksheet, I already set that in scope with my With statement, and you shouldn't code a loop to set the CF, loops are inefficient, and it can be done with setting the range appropriately.



'<<<<< no need for Set tblSh = Worksheets("Table") and then With tblSh, the earlier With Worksheets("Table") aalready achieves that

With .Cells(targetrow, 7).Resize(, 10) '<<<< resizing eliminates the loop

For k = .FormatConditions.Count To 1 Step -1 '<<<<< delete existing condition, from the bottom up

.FormatConditions(k).Delete
Next k

.FormatConditions.Add Type:=xlCellValue, Operator:=xlLess, Formula1:="=100%"
.FormatConditions(.FormatConditions.Count).SetFirstPriority
.FormatConditions(.FormatConditions.Count).Font.Bold = True
.FormatConditions(.FormatConditions.Count).Font.Color = vbRed

.FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, Formula1:="=100%"
.FormatConditions(.FormatConditions.Count).Font.Bold = True
.FormatConditions(.FormatConditions.Count).Font.Color = vbGreen
End With

BTW, I thought you said you had speeded it up, it is slower than ever.

BTBTW, you should also remove your row groupings each run, as these also stack up.

jazz2409
05-11-2020, 04:54 AM
My original workbook is actually working a bit faster than the one I uploaded (I'm not sure why).. Hmm will that be the same for the sub categories? Will the formula for the sub categories be =R9="P" and =R9="F"?

Bob Phillips
05-11-2020, 05:24 AM
What formula are you referring to?

jazz2409
05-11-2020, 06:16 AM
The one for the sub categories.. Will it be =R9="P" and =R9="F"?

Bob Phillips
05-11-2020, 06:28 AM
I still do not know what you are referring to, there is no such test in the code that I can see.

jazz2409
05-11-2020, 07:48 AM
For the sub categories part I did this:


With .Cells(targetrow, 7).Resize(, 10) '<<<< resizing eliminates the loop
For k = .FormatConditions.Count To 1 Step -1 '<<<<< delete existing condition, from the bottom up

.FormatConditions(k).Delete
Next k


.FormatConditions.Add Type:=xlCellValue, Operator:=xlLess, Formula1:="=R10=""F"""
.FormatConditions(.FormatConditions.Count).SetFirstPriority
.FormatConditions(.FormatConditions.Count).Font.Bold = True
.FormatConditions(.FormatConditions.Count).Font.Color = vbRed


.FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, Formula1:="=R10=""P"""
.FormatConditions(.FormatConditions.Count).Font.Bold = True
.FormatConditions(.FormatConditions.Count).Font.Color = vbGreen
End With


didn't work :(

Here is the updated file with your codes aboce

Bob Phillips
05-11-2020, 12:12 PM
Almost, the Type should be xlExpression


With .Cells(targetrow, 7).Resize(, 10)

For k = .FormatConditions.Count To 1 Step -1

.FormatConditions(k).Delete
Next k


.FormatConditions.Add Type:=xlExpression, Formula1:="=R10=""F"""
.FormatConditions(.FormatConditions.Count).SetFirstPriority
.FormatConditions(.FormatConditions.Count).Font.Bold = True
.FormatConditions(.FormatConditions.Count).Font.Color = vbRed


.FormatConditions.Add Type:=xlExpression, Formula1:="=R10=""P"""
.FormatConditions(.FormatConditions.Count).Font.Bold = True
.FormatConditions(.FormatConditions.Count).Font.Color = vbGreen
End With

Bob Phillips
05-11-2020, 12:22 PM
BTW, you can change SetupHeadings to stop the row groups stacking up


Private Function SetupHeadings(ByVal loc As Long) As Boolean
Dim i As Long

With Worksheets("Table")

With .Cells(loc, "A")

.Range("A1:P1").Value = Array(vbNullString, vbNullString, vbNullString, vbNullString, vbNullString, vbNullString, "MTD", "MTD -1", "WEEK 0", "WEEK -1", "WEEK -2", "WEEK -3", "WEEK -4", "WEEK -5", "WEEK -6", "WEEK -7")
.Range("G1:H1").Interior.Color = RGB(48, 84, 150)
.Range("I1:P1").Interior.Color = RGB(198, 89, 17)
.Range("A1:P1").Font.Color = vbWhite
.Range("A2:F2").Value = Array("OWNER", "CATEGORY", "SUBCATEGORY", "X", "CLASSIFICATION", "TARGET")
.Range("A2:H2").Interior.Color = RGB(142, 169, 219)
.Range("I2:P2").Interior.Color = RGB(244, 176, 132)
.Range("G2").FormulaR1C1 = "=MAX(IF(Monthly!C[7]=Table!R[-7]C,Monthly!C[3]))"
.Range("H2").FormulaR1C1 = "=EOMONTH(RC[-1],-1)"
.Range("I2").FormulaR1C1 = "=MAX(IF(Weekly!C[5]=Table!R[-7]C[-2],Weekly!C[1]))"
.Range("G2:P2").NumberFormat = "dd-mmm"
.Range("J2:P2").FormulaR1C1 = "=RC[-1]-7"
.Range("A1:P2").HorizontalAlignment = xlCenter
.Range("A1:P2").Font.Bold = True
End With

If .Rows(loc + 3).OutlineLevel > 1 Then

Do While .Rows(loc + 3).OutlineLevel > 1

.Cells.Rows.Ungroup
Loop
End If
End With
End Function

jazz2409
05-11-2020, 04:56 PM
Hmmm something's wrong with it.. I'm on cell H10, the condition should be if S10="P" or if S10="F", but here it shows R10="P" and is applied to G10 to P10

26634

Bob Phillips
05-12-2020, 02:13 AM
That is just you misunderstanding how CF works, When applied to a range of cells, it will always show the condition that was setup, it will noit adjust the formula to the active cell. But it does do that in the background calculation. Surely you can see that by the fact that those aligning to F are red, the others are green.

Bob Phillips
05-12-2020, 02:16 AM
There is one problem though, all CF formulas are testing row 10, not the current row. It should be


With .Cells(targetrow, 7).Resize(, 10)

For k = .FormatConditions.Count To 1 Step -1

.FormatConditions(k).Delete
Next k


.FormatConditions.Add Type:=xlExpression, Formula1:="=R" & targetrow & "=""F"""
.FormatConditions(.FormatConditions.Count).SetFirstPriority
.FormatConditions(.FormatConditions.Count).Font.Bold = True
.FormatConditions(.FormatConditions.Count).Font.Color = vbRed


.FormatConditions.Add Type:=xlExpression, Formula1:="=R" & targetrow & "=""P"""
.FormatConditions(.FormatConditions.Count).Font.Bold = True
.FormatConditions(.FormatConditions.Count).Font.Color = vbGreen
End With

jazz2409
05-12-2020, 08:34 PM
Perfect! As always! Thank you! :bow: