PivotTable FormatConditions ScopeType is causing 1004 [duplicate] - excel

This question already has an answer here:
Conditional formatting a pivottable report
(1 answer)
Closed 9 years ago.
A 1004 error occurs at the very end of the Sub, when trying to set the ScopeType. I want the formatcondition to apply to all active rows in the current column, so I thought this would do it.
Sub CreatePivot()
' Define RngTarget and RngSource as Range type variables
Dim RngTarget As Range
Dim RngSource As Range
Dim intLastCol As Integer
Dim intCntrCol As Integer
Dim ws1, ws2 As Worksheet
Dim pt As PivotTable
Dim cf As FormatCondition
Set ws1 = ThisWorkbook.Sheets("Sheet1")
Set ws2 = ThisWorkbook.Sheets("Sheet2")
ws2.Cells.Clear
' RngTarget is where the PivotTable will be created (ie: Sheet2, Cell B3)
Set RngTarget = ws2.Range("B3")
'Set RngTarget = ThisWorkbook.Worksheets("Sheet2").Range("B3")
' RngSource defines the Range that will be used to create the PivotTable
' ActiveWorkbook = The currently opened Workbook
' ActiveSheet = The currectly opened sheet
' UsedRange = The Range of cells with active data in them
Set RngSource = ws1.UsedRange
'Set RngSource = ActiveWorkbook.ActiveSheet.UsedRange
' Select the Range
ws1.Select
RngSource.Select
' Copy the Range into the clipboard
RngSource.Copy
' Create a new PivotTable using the RngSource defined above,
' in Excel format,
' placed at the RngTarget location,
' And name it PivotB3 just for reference if needed
ActiveWorkbook.PivotCaches.Create(xlDatabase, RngSource).CreatePivotTable RngTarget, "PivotB3"
Set pt = RngTarget.PivotTable
' Get the last used column from the data table
intLastCol = RngSource.Columns(RngSource.Columns.Count).Column
' Select the Pivot table so we can apply the conditional formats
pt.PivotSelect "", xlDataAndLabel, True
For intCntrCol = 3 To intLastCol
ws2.Select
ws2.Cells(4, intCntrCol).Select ' Select the current Sum column
Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlLess, Formula1:="=5000" ' Set conditional format to less than 5000
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority ' Take priority over any other formats
With Selection.FormatConditions(1).Font ' Use the Font property for the next operations
.ThemeColor = xlThemeColorLight1 ' Set it to the default (if it does not meet the condition)
.TintAndShade = 0 ' Same as above
End With
With Selection.FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.Color = 65535 ' Set the background color to Yellow
.TintAndShade = 0
End With
Selection.FormatConditions(1).StopIfTrue = False
Selection.FormatConditions(1).ScopeType = xlFieldsScope ' Apply the format to all rows that match "Sum of xxxx"
Next intCntrCol
End Sub

Based on you last question I propose this method for applying your formatting:
Set ws2 = ThisWorkbook.Sheets("Sheet2")
With ws2.UsedRange
.FormatConditions.Add Type:=xlCellValue, Operator:=xlLess, Formula1:="=5000" ' Set conditional format to less than 5000
.FormatConditions(.FormatConditions.Count).SetFirstPriority ' Take priority over any other formats
With .FormatConditions(1).Font ' Use the Font property for the next operations
.ThemeColor = xlThemeColorLight1 ' Set it to the default (if it does not meet the condition)
.TintAndShade = 0 ' Same as above
End With
With .FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.Color = 65535 ' Set the background color to Yellow
.TintAndShade = 0
End With
.FormatConditions(1).StopIfTrue = False
End With

Related

How to find and apply format in multiple sheets in excel?

I would like to find the week number and apply formatting to that cell. The week number is generated automatically using weeknum formula in Sheets("Program").Range("N3").
I have 5 sheets. In 1st sheet Overview, the data is in row 8 and the formatting works. In sheet 2 to 5 the data is in row 4. So, I selected all 4 sheets and used the same logic. But the formatting is not working on sheet BBB, CCC, DDD.
My program not showing any error and not working. Can any one help me?
Sub FindandFormat()
Dim ws1, ws2, ws3 As Worksheet
Dim CW As String
Dim rng2, rng1 As Range
Set ws1 = ThisWorkbook.Worksheets("Overview")
Set ws2 = ThisWorkbook.Worksheets("AAA")
' "Format to show the actual week in every sheet"
CW = "W" & ThisWorkbook.Worksheets("Program").Range("N3").Value - 1
With ws1
Set rng1 = .Rows("8:8").Find(What:=CW, LookIn:=xlValues)
With rng1.Interior
.ThemeColor = xlThemeColorAccent6
.TintAndShade = 0.599993896298105
End With
End With
With ws2
Set rng2 = .Rows("4:4").Find(What:=CW, LookIn:=xlValues)
ThisWorkbook.Sheets(Array("AAA", "BBB", "CCC", "DDD")).Select
With rng2.Interior
.ThemeColor = xlThemeColorAccent6
.TintAndShade = 0.599993896298105
End With
End With
End Sub
Note that if you declare Dim ws1, ws2, ws3 As Worksheet only ws3 is of type Worksheet but the others are of type Variant. In VBA you need to specify a type for every variable or they are Variant by default: Dim ws1 As Worksheet, ws2 As Worksheet, ws3 As Worksheet. Same for your Range.
The issue in this code is that selecting those sheets does nothing but selecting them.
With ws2
Set rng2 = .Rows("4:4").Find(What:=CW, LookIn:=xlValues)
ThisWorkbook.Sheets(Array("AAA", "BBB", "CCC", "DDD")).Select
With rng2.Interior
.ThemeColor = xlThemeColorAccent6
.TintAndShade = 0.599993896298105
End With
End With
You apply the format to With rng2.Interior and rng2 references to .Rows("4:4")… which uses With ws2 so clearly applies only to ws2! It applies it to ws2 no matter which worksheets are selected.
Instead you need to loop over your worksheets and apply the format to every worksheet:
Dim WorksheetNames As Variant ' define the worksheet names you want the format to apply to
WorksheetNames = Array("AAA", "BBB", "CCC", "DDD")
Dim WorksheetName As Variant
For Each WorksheetName In WorksheetNames ' loop through all worksheet names in the array
Dim FoundAt As Range ' try to find CW in each worksheet
Set FoundAt = ThisWorkbook.Worksheets(WorksheetName).Rows("4:4").Find(What:=CW, LookIn:=xlValues)
' check if CW was found otherwise show error message
If Not FoundAt Is Nothing Then
With FoundAt.Interior ' perform format change
.ThemeColor = xlThemeColorAccent6
.TintAndShade = 0.599993896298105
End With
Else
MsgBox """" & CW & """ was not found.", vbOKonly
End If
Next WorksheetName

VBA Compare single row values and highlight the entire row if different

My code uses conditional formatting to look at the row values in Column A "Order ID", compares them, and then formats the cell if the row values are different. Instead of formatting the cell, how do I format the entire row based off of consecutive row values in Column A "Order ID" being different?
Said differently - if the value in Column A "Order ID" is different from the previous value in Column A "Order ID", I want to format the entire row that is different. My data is variable everyday so I need to use VBA!
Here is the output of my current code:
This is the desired outcome:
Here is the code
Sub Fulfillment()
'
' Fulfillment Macro
' Format the order number in column A as plum
Range("A2").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
"=MOD(SUM((A$2:A2<>A$1:A1)*1),2)=0"
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With Selection.FormatConditions(1).Font.Color = RGB(0, 0, 0)
End With
With Selection.FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.Color = RGB(221, 160, 221)
.TintAndShade = 0
End With
Selection.FormatConditions(1).StopIfTrue = False
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
Thank you! I do not necessarily need a conditional formatting solution, just a VBA solution that works dynamically.
A Different Flavor of Banded Rows
Option Explicit
Sub Fulfillment()
'
' Fulfillment Macro
' Format the order number in column A as plum
Const CriteriaColumn As Long = 1
Dim wb As Workbook: Set wb = ThisWorkbook
Dim ws As Worksheet: Set ws = wb.Worksheets("Sheet1") ' adjust
Dim rg As Range: Set rg = ws.Range("A1").CurrentRegion
Set rg = rg.Resize(rg.Rows.Count - 2).Offset(2) ' exclude first two rows
Application.ScreenUpdating = False
rg.Interior.Color = xlNone
Dim Col As Long: Col = 1
Dim cell As Range
Dim r As Long
For Each cell In rg.Columns(CriteriaColumn).Cells
r = r + 1
If cell.Value <> cell.Offset(-1).Value Then Col = Col Mod 2 + 1
If Col = 2 Then rg.Rows(r).Interior.Color = RGB(221, 160, 221)
Next cell
Application.ScreenUpdating = True
MsgBox "Fulfillment accomplished.", vbInformation
End Sub

Conditional formatting to highlight specific cells but not empty and text cells VBA

I have a macro which highlights cells outside a range. The only problem with it, is that it also highlights all empty cells and cells with text. Is there a way for it to ignore these?
Here is my code
Sub Highlight()
'
' Highlight good values
Application.ScreenUpdating = False
Dim ws As Worksheet
For Each ws In ActiveWorkbook.Worksheets
ws.Activate
With ActiveSheet.Rows("18:79")
.FormatConditions.Add Type:=xlCellValue, Operator:=xlNotBetween, _
Formula1:="=$C18", Formula2:="=$D18"
.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With .FormatConditions(1).Font
.Color = -16752384
.TintAndShade = 0
End With
With .FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.Color = 13561798
.TintAndShade = 0
End With
.FormatConditions(1).StopIfTrue = False
End With
Next ws
Application.ScreenUpdating = True
End Sub
You currently only have a row limitation to the range you are applying the conditional formatting to. If you want to limit the impacted range you just need to change your With to have both a Row and a Column limitation.
Update This:
With ActiveSheet.Rows("18:79")
To This:
With ActiveSheet.Range("A18:O79")
Edit
If each sheet has the SAME row range (18:79) but the columns have a VARYING range you just need to create a last column variable to create your dynamic range
Sub Highlight()
Dim ws As Worksheet, LC As Long
For Each ws In ActiveWorkbook.Worksheets
LC = ws.Cells(18, ws.Columns.Count).End(xlToLeft).Column
With ws.Range(ws.Cells(18, 1), ws.Cells(79, LC))
'Formatting goes here
End With
Next ws
End Sub

Conditionally format unique rows in a pivot table, and transfer this formatting to other cells without the rules or values

I have a pivot table which summarizes three key figures for each individual item in our inventory over a six week time frame.
I want to conditionally format with a color scale the six cells in the "Supplier Inventory DOH" rows for each individual item.
Once those six cells are formatted, I want to copy those colors to the coordinating six cells below in "Total Inventory" without the rules or values which come with the formatting typically.
The purpose of this is to show the Days on Hand risk by color scale, in coordination with the current inventory - think of it as layering formatting on top of the inventory values.
For the formatting process alone I found a similar related discussion referencing this article: Excel conditional colour scale for multiple rows, and I tried using the code it included in the comments. I changed the code and its references to match what I would need- knowing full well that this code is meant just for a blanket drag and drop over all of the data-not for the unique rows themselves. If this code worked I hoped it would be a start at least- however after running it through it didn't do anything. I am wondering if some of this code is incorrect, what kind of code I would add in to only format the rows with the Supplier Inventory DOH description, or if there was a better way to do this?
For the copying formatting piece, I found a related article discussion: How to copy the conditional formatting without copying the rules from a Conditional Formatted cell?, however copy and pasting just the color themselves did not work on my Windows 10 excel version. Is there a way to do this process as well?
Original version of code:
Option Explicit
Sub ApplyConditionalFormatting()
Dim ws As Worksheet: Set ws = ThisWorkbook.Sheets("Sheet1") ' change to your sheet here
Dim rw As Long
Dim rng As Range
For rw = 3 To 8 ' change to your respective rows
With ws
Set rng = .Range(.Cells(rw, "E"), .Cells(rw, "K")) ' change to your respective columns
With rng
.FormatConditions.AddColorScale ColorScaleType:=3
.FormatConditions(.FormatConditions.Count).SetFirstPriority ' now its index is 1, in case there already was cond formatting applied
End With
With rng.FormatConditions(1)
With .ColorScaleCriteria(1)
.Type = xlConditionValueNumber
.Value = 0
.FormatColor.Color = 7039480
End With
With .ColorScaleCriteria(2)
.Type = xlConditionValueFormula
.Value = "='" & ws.Name & "'!$D$" & rw & "*3" ' References column D, change as needed
.FormatColor.Color = 8711167
End With
With .ColorScaleCriteria(3)
.Type = xlConditionValueFormula
.Value = "='" & ws.Name & "'!$D$" & rw & "*5" ' References column D, change as needed
.FormatColor.Color = 8109667
End With
End With
End With
Next rw
End Sub
My version of the code:
Sub CF()
'
' CF Macro
'
' Keyboard Shortcut: Ctrl+f
'
End Sub
Public Sub Formatting()
Option Explicit
Sub ApplyConditionalFormatting()
Dim ws As Worksheet: Set ws = ThisWorkbook.Sheets("Sheet2")
Dim rw As Long
Dim rng As Range
For rw = 6 To 1764
With ws
Set rng = .Range(.Cells(rw, "B"), .Cells(rw, "G"))
With rng
.FormatConditions.AddColorScale ColorScaleType:=3
.FormatConditions(.FormatConditions.Count).SetFirstPriority
End With
With rng.FormatConditions(1)
With .ColorScaleCriteria(1)
.Type = xlConditionValueNumber
.Value = 40
.FormatColor.Color = 7039480
End With
With .ColorScaleCriteria(2)
.Type = xlConditionValueFormula
.Value = 70
.FormatColor.Color = 8711167
End With
With .ColorScaleCriteria(3)
.Type = xlConditionValueFormula
.Value = 80
.FormatColor.Color = 8109667
End With
End With
End With
Next rw
End Sub
End Sub
I expect the rows for each individual items DOH to be conditionally formatted based on the rule I need in an automated process that doesn't include going row by row with format painter. Then, to be able to copy those colors to the Total Inventory cells below (without the rules or values) to be able to show the correlation between Days on Hand and what is left in the inventory.
Pivot Table with Rule:
Pivot table with desired formatting:
You can get all relevant cells by PivotSelect,
then add your desired conditional formatting to them,
and use the resulting DisplayFormat.Interior.Color as Interior.Color for your "Total Inventory" cells.
Private Sub ConditionalFormattingforSNCPlanning()
Dim ws As Excel.Worksheet
Dim pt As Excel.PivotTable
Dim fc As Excel.FormatCondition
Dim cs As Excel.ColorScale
Dim strDOH As String, strTotal As String
Dim rngSource As Range, rngDest As Range, rngCell As Range, strDest() As String
Set ws = ActiveWorkbook.Sheets("Sheet2")
Set pt = ws.PivotTables(1)
strDOH = "'SNC PLANNING' 'Supplier Network DOH'"
strTotal = "'SNC PLANNING' 'Total Inventory'"
' Delete all conditional colors and normal interior colors first
With pt.TableRange2
.FormatConditions.Delete
.Interior.ColorIndex = xlNone
.Interior.Pattern = xlNone
End With
' Show all pivottable rows, as otherwise PivotSelect may fail
Dim i As Long
For i = pt.RowFields.Count To 2 Step -1
pt.RowFields(i).ShowDetail = True
Next i
' select all desired rows for conditional formatting
pt.PivotSelect _
Name:=strDOH, _
Mode:=XlPTSelectionMode.xlDataOnly, _
Usestandardname:=True
' if you don't want to delete every conditional format
' by above pt.TableRange2.FormatConditions.Delete
' then use following line here instead
' Selection.FormatConditions.Delete
' Add a new conditional formatting (3-Color Scale)
Set cs = Selection.FormatConditions.AddColorScale(ColorScaleType:=3)
With cs.ColorScaleCriteria(1)
.Type = xlConditionValueNumber
.Value = 40
.FormatColor.Color = RGB(248, 105, 107) ' 7039480
.FormatColor.TintAndShade = 0
End With
With cs.ColorScaleCriteria(2)
.Type = xlConditionValueNumber
.Value = 70
.FormatColor.Color = RGB(255, 235, 132) ' 8711167
.FormatColor.TintAndShade = 0
End With
With cs.ColorScaleCriteria(3)
.Type = xlConditionValueNumber
.Value = 80
.FormatColor.Color = RGB(99, 190, 123) ' 8109667
.FormatColor.TintAndShade = 0
End With
' Get both ranges for later color-copy-code
Set rngSource = Selection
pt.PivotSelect _
Name:=strTotal, _
Mode:=XlPTSelectionMode.xlDataOnly, _
Usestandardname:=True
Set rngDest = Selection
' Exit if both range's cell count not equal
If rngSource.Cells.Count <> rngDest.Cells.Count Then
MsgBox "Sorry, this works only, if cell count is identical"
Exit Sub
End If
' store all addresses of the destination range's cells
ReDim strDest(1 To rngDest.Cells.Count)
i = 1
For Each rngCell In rngDest.Cells
strDest(i) = rngCell.AddressLocal
i = i + 1
Next rngCell
' copy source's DisplayFormat.Interior.Color
' to destination's Interior.Color
' cell by cell
i = 1
For Each rngCell In rngSource.Cells
ws.Range(strDest(i)).Interior.Color = rngCell.DisplayFormat.Interior.Color
i = i + 1
Next rngCell
End Sub
This is a different approach with a loop over the PivotTable.RowRange. When the desired terms are found, the corresponding row of the PivotTable.DataBodyRange is coloured.
The "Source" (e. g. "Supplier Network DOH") is formatted via conditional formatting and the "Destination" (e. g. "Total Inventory") gets the displayed color of the previously conditional formatted row as interior color.
Private Sub ConditionalFormattingforSNCPlanningVersion2()
Dim ws As Excel.Worksheet
Dim pt As Excel.PivotTable
Dim fc As Excel.FormatCondition
Dim cs As Excel.ColorScale
Dim SourceString As String, DestString As String
Dim SourceIsFound As Boolean
Dim SourceRow As Long, DestRow As Long
Dim CellInColumn As Range, CellInRow As Range
Set ws = ActiveWorkbook.ActiveSheet
Set pt = ws.PivotTables(1)
SourceString = "Supplier Network DOH"
DestString = "Total Inventory"
' Delete all conditional colors and normal interior colors first
With pt.TableRange2
.FormatConditions.Delete
.Interior.ColorIndex = xlNone
.Interior.Pattern = xlNone
End With
' Show all pivottable rows
Dim i As Long
For i = pt.RowFields.Count To 2 Step -1
pt.RowFields(i).ShowDetail = True
Next i
' loop all cells in last column of rowrange
For Each CellInColumn In pt.RowRange.Columns(pt.RowRange.Columns.Count).Cells
' If row is source, then add conditional formatting
If CellInColumn.Value = SourceString Then
SourceIsFound = True
SourceRow = CellInColumn.Row
Set cs = Intersect(ws.Rows(SourceRow).EntireRow, pt.DataBodyRange).FormatConditions.AddColorScale(ColorScaleType:=3)
With cs.ColorScaleCriteria(1)
.Type = xlConditionValueNumber
.Value = 40
.FormatColor.Color = RGB(248, 105, 107) ' 7039480
.FormatColor.TintAndShade = 0
End With
With cs.ColorScaleCriteria(2)
.Type = xlConditionValueNumber
.Value = 70
.FormatColor.Color = RGB(255, 235, 132) ' 8711167
.FormatColor.TintAndShade = 0
End With
With cs.ColorScaleCriteria(3)
.Type = xlConditionValueNumber
.Value = 80
.FormatColor.Color = RGB(99, 190, 123) ' 8109667
.FormatColor.TintAndShade = 0
End With
End If
' If cell is destination, then copy color of previously found sourcerow
If CellInColumn.Value = DestString Then
If SourceIsFound Then
DestRow = CellInColumn.Row
For Each CellInRow In Intersect(ws.Rows(SourceRow).EntireRow, pt.DataBodyRange).Cells
ws.Cells(DestRow, CellInRow.Column).Interior.Color = CellInRow.DisplayFormat.Interior.Color
Next CellInRow
SourceIsFound = False
End If
End If
Next CellInColumn
End Sub

Conditional formatting a pivottable report

I need to get the pre-assigned conditional format from Sheet1:B3 and apply it to all used cells in a generated PivotTable report. So there are two parts that I am having a problem with. First would be finding out the usedrange for the report, and the second is getting the format and applying it to those cells. The 3 spots with errors are marked with '' DOES NOT WORK
Sub CreatePivot()
' Define RngTarget and RngSource as Range type variables
Dim RngTarget As Range
Dim RngSource As Range
Dim intLastCol As Integer
Dim intLCPivot As Integer
Dim intLRPivot As Integer
Dim intCntrCol As Integer
Dim intX, intY As Integer
Dim ws1, ws2 As Worksheet
Dim pt As PivotTable
Dim strHeader As String
Dim cf As FormatCondition
Set ws1 = ThisWorkbook.Sheets("Sheet1")
Set ws2 = ThisWorkbook.Sheets("Sheet2")
ws2.Cells.Clear
' RngTarget is where the PivotTable will be created (ie: Sheet2, Cell B3)
Set RngTarget = ws2.Range("B3")
'Set RngTarget = ThisWorkbook.Worksheets("Sheet2").Range("B3")
' RngSource defines the Range that will be used to create the PivotTable
' ActiveWorkbook = The currently opened Workbook
' ActiveSheet = The currectly opened sheet
' UsedRange = The Range of cells with active data in them
Set RngSource = ws1.UsedRange
' Copy the Range into the clipboard
RngSource.Copy
' Create a new PivotTable using the RngSource defined above,
' in Excel format,
' placed at the RngTarget location,
' And name it PivotB3 just for reference if needed
ActiveWorkbook.PivotCaches.Create(xlDatabase, RngSource).CreatePivotTable RngTarget, "PivotB3"
Set pt = RngTarget.PivotTable
' Get the last used column from the data table
intLastCol = RngSource.Columns(RngSource.Columns.Count).Column
' Add all columns to the report
ws2.Select
With ActiveSheet.PivotTables("PivotB3").PivotFields("RECORDTYPE")
.Orientation = xlRowField
.Position = 1
End With
For intX = 3 To intLastCol
strHeader = ws1.Cells(3, intX).Value
ActiveSheet.PivotTables("PivotB3").AddDataField ActiveSheet.PivotTables("PivotB3").PivotFields(strHeader), "Sum of " & strHeader, xlSum
Next intX
'' DOES NOT WORK
' Get the last used row and column from the generated pivottable report so that conditional formatting
' can be applied to each used cell
intLCPivot = pt.DataBodyRange.Columns(pt.DataBodyRange.Columns.Count).Column
intLRPivot = pt.DataBodyRange.Rows(pt.DataBodyRange.Rows.Count).Row
' Select the Pivot table so we can apply the conditional formats
pt.PivotSelect "", xlDataAndLabel, True
'' DOES NOT WORK
' Get the conditional format from Sheet1:B3 and apply it to all used cells in the pivottable
'cf = ws1.Range("B3").FormatCondition
ws2.Select
For intX = 2 To intLCPivot
For intY = 5 To intLRPivot
ws2.Cells(intY, intX).Select ' Select the current Sum column
'' DOES NOT WORK
'Selection.FormatConditions.Add cf
Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlLess, Formula1:="=5000" ' Set conditional format to less than 5000
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority ' Take priority over any other formats
With Selection.FormatConditions(1).Font ' Use the Font property for the next operations
.ThemeColor = xlThemeColorLight1 ' Set it to the default (if it does not meet the condition)
.TintAndShade = 0 ' Same as above
End With
With Selection.FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.Color = 65535 ' Set the background color to Yellow
.TintAndShade = 0
End With
Selection.FormatConditions(1).StopIfTrue = False
Next intY
Next intX
End Sub
Based on you last question I propose this method for applying your formatting:
Set ws2 = ThisWorkbook.Sheets("Sheet2")
With ws2.UsedRange
.FormatConditions.Add Type:=xlCellValue, Operator:=xlLess, Formula1:="=5000" ' Set conditional format to less than 5000
.FormatConditions(.FormatConditions.Count).SetFirstPriority ' Take priority over any other formats
With .FormatConditions(1).Font ' Use the Font property for the next operations
.ThemeColor = xlThemeColorLight1 ' Set it to the default (if it does not meet the condition)
.TintAndShade = 0 ' Same as above
End With
With .FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.Color = 65535 ' Set the background color to Yellow
.TintAndShade = 0
End With
.FormatConditions(1).StopIfTrue = False
End With
Based on comment if you have a cell that has the conditional formatting copy it over:
ws1.[B3].Copy
ws2.UsedRange.PasteSpecial Paste:=xlPasteFormats
Also if you need to remove the headers this will be difficult but if the number of headers and first columns in known the offset method will help:
With ws2.UsedRange
Dim c1 As Range, c2 As Range
Set c1 = .Cells(1).Offset(2, 1) '<~~ 2 rows down and 1 column in
Set c2 = .Cells(.Cells.Count).Offset(-1) '<~~ 1 row up
End With
With ws2.Range(c1, c2)
'<~~ add conditions here
end with

Resources