VBA Conditional Formating

helpexcel

Well-known Member
Joined
Oct 21, 2009
Messages
602
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

Format cells as time
Select range and press Ctrl+Shift+2 to format cells as time. (Shift 2 is the @ sign).

helpexcel

Well-known Member
Joined
Oct 21, 2009
Messages
602
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
 

Joe4

MrExcel MVP, Junior Admin
Joined
Aug 1, 2002
Messages
59,397
Office Version
  1. 365
Platform
  1. Windows
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.
 

helpexcel

Well-known Member
Joined
Oct 21, 2009
Messages
602
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
 

Joe4

MrExcel MVP, Junior Admin
Joined
Aug 1, 2002
Messages
59,397
Office Version
  1. 365
Platform
  1. Windows

ADVERTISEMENT

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.
 

helpexcel

Well-known Member
Joined
Oct 21, 2009
Messages
602
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.
 

helpexcel

Well-known Member
Joined
Oct 21, 2009
Messages
602
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
 

Joe4

MrExcel MVP, Junior Admin
Joined
Aug 1, 2002
Messages
59,397
Office Version
  1. 365
Platform
  1. Windows
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
 

Forum statistics

Threads
1,143,675
Messages
5,720,237
Members
422,271
Latest member
xbaca

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
Top