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

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

Related

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

How to check for duplicates, highlight duplicates, and count the highlighted duplicates in a single column?

I want to highlight and count the number of duplicates in a single concatenated column.
I have it as two separate subs right now and there really isn't much more to say, this isn't that hard of a problem I'm confident of that but I have been working on it for days with absolutely no progress. It has to be done in a VBA and it cannot highlight blank cells in the column. The concatenations are done through a formula in the workbook. Please help me, I m dying,
Sub Duplicate_Check()
Dim ws As Worksheet
Set ws = Sheet1
Worksheets("Master Checklist").Activate
Columns("H:H").Select
Selection.FormatConditions.AddUniqueValues
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
Selection.FormatConditions(1).DupeUnique = xlDuplicate
With Selection.FormatConditions(1).Interior
.ColorIndex = 40
.TintAndShade = 0
End With
'Sheet2.Range(“L2").Value = Application.WorksheetFunction.Countif(Columns("H:H")), cell.Font.Color = "-16383844")
'Range(“B10?).Value = Application.WorksheetFunction.Countif(Range(“A2:A8?), “>” & 50
End Sub
Sub CountDupes()
Dim countofDupes As Long
Dim rng As Range
Dim myCell As Range
countofDupes = 0
Set rng = Range("H2").End(xlDown)
For Each myCell In rng
If myCell.Interior.ColorIndex = 40 Then
countofDupes = countofDupes + 1
Debug.Print countofDupes
End If
Next myCell
End Sub
I don't encounter any error messages but if I Debug.Print countofDupes I get nothing returned, which it obviously not what I want. Any advice?

Applying same macro to a variety of ranges

I have a code that does what I want it to do, but it's HUGE, as i used the macro recorder to make it. Basically, it selects a range, applies two conditional formats and goes to the next range. I can't select the whole ranges at once because the conditional format applies an AVERAGE on each range.
Here's a piece of the code:
Sub DesvPad()
Range("C3:N3").Select
Selection.FormatConditions.AddAboveAverage
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
Selection.FormatConditions(1).AboveBelow = xlAboveStdDev
With Selection.FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.Color = 5296274
.TintAndShade = 0
End With
Selection.FormatConditions(1).NumStdDev = 1
Selection.FormatConditions(1).StopIfTrue = False
Selection.FormatConditions.AddAboveAverage
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
Selection.FormatConditions(1).AboveBelow = xlBelowStdDev
With Selection.FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.Color = 49407
.TintAndShade = 0
End With
Selection.FormatConditions(1).NumStdDev = 1
Selection.FormatConditions(1).StopIfTrue = False
MsgBox "O macro foi executado até Range(C325:N325)"
End Sub
I know it's shameful, so I'll appreciate any help!
It's not really clear what your question is but I'll guess you're asking how to make your code more "modular" "
Sub Tester()
ApplyCF Range("A1:A10")
ApplyCF Range("A11:A20")
'etc
End Sub
Sub ApplyCF(rng As Range)
'here use rng instead of "Selection"
rng.FormatConditions.AddAboveAverage '<< for example
End Sub
I think this could help:
Sub formatInMySelectedSheets() 'use this just for few sheet
'that you want to change
Dim i As Worksheet
Dim Nm(1 To 3) As String
Dim s
Dim sht As Worksheet
'Imagine the book has 10 sheets, "Sheet1" to "Sheet10"
'but you only want to go to Sheet1, Sheet4 and Sheet7
Nm(1) = "Sheet1" 'this are the sheets you want to change
Nm(2) = "Sheet4"
Nm(3) = "Sheet7"
For Each i In ActiveWorkbook.Worksheets 'the workbook with the sheets...
For s = LBound(Nm) To UBound(Nm) 'from the lowest value of the array to
'to the highest
Set sht = Sheets(Nm(s))
'here the code shows the sheet to avoid some errors
'if the sheet is hidden, Show it to me!
If sht.Visible = xlSheetVeryHidden Or sht.Visible = xlSheetHidden Then
sht.Visible = xlSheetVisible
End If
'go to the sheet
sht.Activate
DesvPad 'Calls you code
Next s
Next i
End Sub
Sub formatInEverySheet() 'Use this to do it in every sheet
'no matter what!
Dim i As Worksheet
For Each i In ActiveWorkbook.Worksheets
i.Activate
' here the code shows the sheet to avoid some errors
If i.Visible = xlSheetVeryHidden Or i.Visible = xlSheetHidden Then
i.Visible = xlSheetVisible
End If
DesvPad 'Calls you code
Next i
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

PivotTable FormatConditions ScopeType is causing 1004 [duplicate]

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

Resources