VBA Conditional Formating

H

helpexcel

Well-known Member
Joined
Oct 21, 2009
Messages
656
This code works great to change the cell colors when importing the data. I'm looking to make it dynamic so that if the value in cell(50, i) is changed the code will rerun. I know you can use the worksheet change code in the Sheet, but these sheets aren't existing, they are added when code is run. I'm also looking to make the color in cells(61,i) and (62,i) the same color as cell(63,i).


VBA Code: 
Dim i As Long
    For i = 2 To LastColumn
        If .Cells(63, i) >= 1 And Not IsEmpty(Cells(63, i)) Then
            .Cells(63, i).Interior.Color = 13434828
        ElseIf .Cells(63, i) < 0 And Not IsEmpty(Cells(63, i)) Then
            .Cells(63, i).Interior.Color = 255
        End If
    Next i
 

Excel Facts

Quick Sum
Select a range of cells. The total appears in bottom right of Excel screen. Right-click total to add Max, Min, Count, Average.
Sort by date Sort by votes
tried this, but no luck...any suggestions.
VBA Code: 
Dim i As Long
    For i = 2 To LastColumn
        If .Cells(63, i) >= 0 And Not IsEmpty(Cells(63, i)) Then
            .Cells(63, i).Interior.Color = 13434828
            .FormatConditions.Add Type:=xlExpression, Formula1:="=B$63>=0"
             .FormatConditions(.FormatConditions.count).SetFirstPriority
                With .FormatConditions(1).Interior
                    .PatternColorIndex = xlAutomatic
                    .Color = 13434828
                    .TintAndShade = 0
                End With
        ElseIf .Cells(63, i) < 0 And Not IsEmpty(Cells(63, i)) Then
            .Cells(63, i).Interior.Color = 255
            .FormatConditions.Add Type:=xlExpression, Formula1:="=B$63<0"
            .FormatConditions(.FormatConditions.count).SetFirstPriority
                With .FormatConditions(1).Interior
                    .PatternColorIndex = xlAutomatic
                    .Color = 255
                    .TintAndShade = 0
                End With
        End If
    Next i
 
Upvote 0
I think you are going to need to paste the rest of your code, so we can see how the new sheets are added, and when/how the Conditional Formatting is added.
 
Upvote 0
OK, this works.

VBA Code: 
With ws
Dim i As Long
    For i = 2 To LastColumn
        If .Cells(63, i) >= 0 And Not IsEmpty(Cells(63, i)) Then
            .Cells(63, i).Interior.Color = 13434828
        ElseIf .Cells(63, i) < 0 And Not IsEmpty(Cells(63, i)) Then
            .Cells(63, i).Interior.Color = 255
        End If
    Next i
End With

With ws
With .Range(.Cells(63, 2), .Cells(63, LastColumn))
    .FormatConditions.Add Type:=xlExpression, Formula1:="=B$63<0"
    .FormatConditions(.FormatConditions.count).SetFirstPriority
        With .FormatConditions(1).Interior
            .PatternColorIndex = xlAutomatic
            .Color = 255
            .TintAndShade = 0
        End With
    .FormatConditions.Add Type:=xlExpression, Formula1:="=B$63>=0"
    .FormatConditions(.FormatConditions.count).SetFirstPriority
        With .FormatConditions(1).Interior
            .PatternColorIndex = xlAutomatic
            .Color = 13434828
            .TintAndShade = 0
        End With
    .FormatConditions(1).StopIfTrue = False
End With
End With
 
Upvote 0
No, that is not the entire code.
I have no idea what "ws" is assigned to, and it doesn't show how these sheets are created.

Please post your ENTIRE procedure, including the "Sub..." and "End Sub" lines.
 
Upvote 0
ws refers to the created worksheet. the last code i pasted does exactly what i want. i did copy the bottom portion of the code twice and changed it to row 61, 62 but kept the formula as row 63.
 
Upvote 0
here's the entire code.
VBA Code: 
Sub Create()

Application.ScreenUpdating = False
Application.DisplayAlerts = False

Dim ws, ws1, wsN As Worksheet
Dim NewName As String, msg As String
Dim LastColumn As Long
Dim rng As Range

Set ws1 = Sheet9

  Do
    Set wsN = Nothing
    NewName = InputBox("What name for the new sheet?" & vbLf & msg)
    On Error Resume Next
    Set wsN = Sheets(NewName)
    msg = "'" & wsN.Name & "' already exists as a sheet name"
    On Error GoTo 0
  Loop Until wsN Is Nothing
  If Len(NewName) > 0 Then Sheets.Add(After:=Sheets(Sheets.count)).Name = NewName
    
Set ws = ActiveSheet
    
With ws1
     '.Rows("38:38").UnMerge
     .Range("I27:X34").COPY
        With ws.Range("A1")
            .PasteSpecial Paste:=xlPasteColumnWidths
            .PasteSpecial Paste:=xlPasteFormats
            .PasteSpecial Paste:=xlPasteValuesAndNumberFormats
            Application.CutCopyMode = False
        End With

     .Range("I38:J137").COPY
        With ws.Range("A12")
            .PasteSpecial Paste:=xlPasteColumnWidths
            .PasteSpecial Paste:=xlPasteFormats
            .PasteSpecial Paste:=xlPasteValuesAndNumberFormats
            Application.CutCopyMode = False
            Range("A13:B17").Delete Shift:=xlUp
        End With
End With

With ws
    .Rows("23:23").EntireRow.Hidden = True
    .Rows("39:39").EntireRow.Hidden = True
    .Rows("43:43").EntireRow.Hidden = True
    .Rows("45:45").EntireRow.Hidden = True
    .Rows("48:49").EntireRow.Hidden = True
    .Rows("64:106").EntireRow.Hidden = True
    .Rows("41:41").RowHeight = 6
    .Rows("47:47").RowHeight = 6
End With

Dim lc As Long
Dim c As Long
Dim sc As Long
    sc = 3
    lc = ws1.Cells(44, Columns.count).End(xlToLeft).Column

With ws1
    For c = 1 To lc
        If .Cells(45, c) = "Y" Then
            .Range(.Cells(44, c), .Cells(94, c)).COPY
                With ws.Cells(13, sc)
                    .PasteSpecial Paste:=xlPasteColumnWidths
                    .PasteSpecial Paste:=xlPasteFormats
                    .PasteSpecial Paste:=xlPasteFormulasAndNumberFormats
                    Application.CutCopyMode = False
                End With
            sc = sc + 1
        End If
    Next c
End With
    
With ws
LastColumn = .Cells(14, Columns.count).End(xlToLeft).Column
    .Range("B32").Formula = "=SUM(C32:INDEX(32:32,MATCH(9.99999999999999E+307,32:32)))"
    .Range("B34").Formula = "=SUM(C34:INDEX(34:34,MATCH(9.99999999999999E+307,34:34)))"
    .Range("B36").Formula = "=SUM(C36:INDEX(36:36,MATCH(9.99999999999999E+307,36:36)))"
    .Range("B46").Formula = "=SUM(C46:INDEX(46:46,MATCH(9.99999999999999E+307,46:46)))"
    .Range("B51").Formula = "=SUM(C51:INDEX(51:51,MATCH(9.99999999999999E+307,51:51)))"
    .Range("B52").Formula = "=SUM(C52:INDEX(52:52,MATCH(9.99999999999999E+307,52:52)))"
    .Range("B53").Formula = "=SUM(C53:INDEX(53:53,MATCH(9.99999999999999E+307,53:53)))"
    .Range("B54").Formula = "=SUM(C54:INDEX(54:54,MATCH(9.99999999999999E+307,54:54)))"
    .Range("B55").Formula = "=SUM(C55:INDEX(55:55,MATCH(9.99999999999999E+307,55:55)))"
    .Range("B56").Formula = "=SUM(C56:INDEX(56:56,MATCH(9.99999999999999E+307,56:56)))"
    .Range("B61").Formula = "=SUM(C61:INDEX(61:61,MATCH(9.99999999999999E+307,61:61)))"
    .Range("B62").Formula = "=SUM(C62:INDEX(62:62,MATCH(9.99999999999999E+307,62:62)))"
    .Range("B63").Formula = "=b62/b51"
    .Range("B56").Formula = "=IF(OR(B46=""N/A"",B46=""""),""N/A"",IF(B46=0,0,B55/B46))"
    .Range("B58").Formula = "=IF(B32=0,""N/A"",B51/B32)"
    .Range("B59").Formula = "=IF(B34=0,""N/A"",B51/B34)"
    .Range("B60").Formula = "=IF(B40=0,""N/A"",B51/B40)"
    .Range(.Cells(46, 3), .Cells(46, LastColumn)) = "=C42*C44*VLOOKUP(C24,NamedRange,2,FALSE)"
    .Range(.Cells(51, 3), .Cells(51, LastColumn)) = "=C42*C50*VLOOKUP(C24,NamedRange,2,FALSE)"
End With

With ws
Dim i As Long
    For i = 2 To LastColumn
        If .Cells(63, i) >= 0 And Not IsEmpty(Cells(63, i)) Then
            .Cells(63, i).Interior.Color = 13434828
        ElseIf .Cells(63, i) < 0 And Not IsEmpty(Cells(63, i)) Then
            .Cells(63, i).Interior.Color = 255
        End If
    Next i
End With

With ws
With .Range(.Cells(63, 2), .Cells(63, LastColumn))
    .FormatConditions.Add Type:=xlExpression, Formula1:="=B$63<0"
    .FormatConditions(.FormatConditions.count).SetFirstPriority
        With .FormatConditions(1).Interior
            .PatternColorIndex = xlAutomatic
            .Color = 255
            .TintAndShade = 0
        End With
    .FormatConditions.Add Type:=xlExpression, Formula1:="=B$63>=0"
    .FormatConditions(.FormatConditions.count).SetFirstPriority
        With .FormatConditions(1).Interior
            .PatternColorIndex = xlAutomatic
            .Color = 13434828
            .TintAndShade = 0
        End With
    .FormatConditions(1).StopIfTrue = False
End With
End With

With ws
With .Range(.Cells(62, 2), .Cells(62, LastColumn))
    .FormatConditions.Add Type:=xlExpression, Formula1:="=B$63<0"
    .FormatConditions(.FormatConditions.count).SetFirstPriority
        With .FormatConditions(1).Interior
            .PatternColorIndex = xlAutomatic
            .Color = 255
            .TintAndShade = 0
        End With
    .FormatConditions.Add Type:=xlExpression, Formula1:="=B$63>=0."
    .FormatConditions(.FormatConditions.count).SetFirstPriority
        With .FormatConditions(1).Interior
            .PatternColorIndex = xlAutomatic
            .Color = 13434828
            .TintAndShade = 0
        End With
    .FormatConditions(1).StopIfTrue = False
End With
End With

With ws
With .Range(.Cells(61, 2), .Cells(61, LastColumn))
    .FormatConditions.Add Type:=xlExpression, Formula1:="=B$63<0"
    .FormatConditions(.FormatConditions.count).SetFirstPriority
        With .FormatConditions(1).Interior
            .PatternColorIndex = xlAutomatic
            .Color = 255
            .TintAndShade = 0
        End With
    .FormatConditions.Add Type:=xlExpression, Formula1:="=B$63>=0"
    .FormatConditions(.FormatConditions.count).SetFirstPriority
        With .FormatConditions(1).Interior
            .PatternColorIndex = xlAutomatic
            .Color = 13434828
            .TintAndShade = 0
        End With
    .FormatConditions(1).StopIfTrue = False
End With
End With
        
Application.DisplayAlerts = True
Application.ScreenUpdating = True

End Sub
 
Upvote 0
OK, I can see that you seem to be applying the rules to the correct sheet. However, without seeing the data that is in there, it is difficult to test it out.
Can you post a sample of what the data on the new sheet should look after the code copies over the data to the new sheet (but before it tries to apply this formatting)?
And then show us an image of what you want it to look like after the formatting part of the code runs?

Also, one other note. This does NOT do what you think it does:
VBA Code: 
Dim ws, ws1, wsN As Worksheet
This will declare "wsN" as Worksheet, but the other two will be set to Variant.

You need to explicitly declare each variable, like this:
VBA Code: 
Dim ws As Worksheet, ws1 As Worksheet, wsN As Worksheet
or like this:
VBA Code: 
Dim ws As Worksheet
Dim ws1 As Worksheet
Dim wsN As Worksheet
 
Upvote 0
You must log in or register to reply here.

Similar threads

H
  • Question
Adjust an existing formula based on most recently added column and prior month end date.
Replies
1
Views
98
healeydm
H
K
  • Question
conditional formatting question
Replies
2
Views
156
kerm007
K
L
  • Solved
Conditional Formatting using VBA
Replies
1
Views
126
Joe4
Joe4
F
  • Solved
Set conditional formatting with VBA
Replies
2
Views
192
FryGirl
F
L
  • Question
Conditional Formatting vba + Reverting the Conditional Formatting if no data
Replies
1
Views
142
leila
L

Forum statistics

Threads
1,214,875
Messages
6,122,040
Members
449,063
Latest member
ak94

Share this page

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