Selecting two columns based on active cell? - vba

I'm trying to do conditional formatting on a long range of columns in groups of 2. Im not sure how record a macro that would select the entire column from the active cell and the column next to it, then apply the conditional formating. Then move two cells down and repeat.
This is what I have so far but it would keep going back to those specific cells, I need it to move to the right 2.
Sub findDups()
'
' findDups Macro
ActiveCell.EntireColumn.Select
Selection.FormatConditions.AddUniqueValues
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
Selection.FormatConditions(1).DupeUnique = xlDuplicate
With Selection.FormatConditions(1).Font
.Color = -16383844
.TintAndShade = 0
End With
With Selection.FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.Color = 13551615
.TintAndShade = 0
End With
Selection.FormatConditions(1).StopIfTrue = False
Range("M1").Select
Worksheets("User Check List").Activate
Selection.Offset(0, 2).Select
End Sub

This should work to get you started. I avoid using Selection at all, and only use ActiveCell as a means of knowing where to start the macro. Preferably, you could do that with an Application.InputBox but that's not a big deal.
Because I don't know how many times you want this to loop, I used a Do ... Loop statement, and this will continue until the column number > 26. You can change that in the Loop Until ... statement.
Sub findDups()
Dim startCell As Range
Dim formatCols As Range
Set startCell = ActiveCell
Do
Set formatCols = startCell.Resize(1, 2).EntireColumn
formatCols.FormatConditions.AddUniqueValues
formatCols.FormatConditions(formatCols.FormatConditions.Count).SetFirstPriority
formatCols.FormatConditions(1).DupeUnique = xlDuplicate
With formatCols.FormatConditions(1).Font
.Color = -16383844
.TintAndShade = 0
End With
With formatCols.FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.Color = 13551615
.TintAndShade = 0
End With
Set startCell = startCell.Offset(0, 2)
Loop Until startCell.Column >= 26
End Sub
Here is an example of the output formatting:

Related

VBA syntax to reference cell on same row inside conditional format

I'm trying to create a VBA Macro to automate part of a large process. I can do it manually but it isn't practical as there are 27K rows.
I have a range of dates in columns F through AC. I'm trying to use conditional formatting to color the ones that fall between the dates in columns A and B on the same row. IE: Row 2 (1 is headers) A2 and B2 are dates that span one year. F2:AC2 are filled with dates that may or may not fall in that range. Turn the ones that do red (pink red text or what ever). Continue for the next 27K rows.
What I have is working on a 57 item sample Except that it only references the original hard coded selections from the macro recording. I'm struggling with the syntax to make it dynamic.
[code]Sub Conditions()
'
' Conditional format
'
Dim x As Integer
Application.ScreenUpdating = False
NumRows = Range("F2", Range("F2").End(xlDown)).Rows.Count
'Range("F2").Select
'Range(("F2"), Selection.End(xlToRight)).Select
Range("F2").Select
Range(("F2"), Selection.End(xlToRight)).Select
For x = 1 To NumRows
Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlBetween, _
Formula1:="=$A$2", Formula2:="=$B$2"
'Formula1:="=ActiveCell.Offset(0,-5)", Formula2:="=ActiveCell.Offset(0,-4)" '<---- offset from active cell
Selection.FormatConditions (Selection.FormatConditions.Count).SetFirstPriority
With Selection.FormatConditions(1).Font
.Color = -16383844
.TintAndShade = 0
End With
With Selection.FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.Color = 13551615
.TintAndShade = 0
End With
Selection.FormatConditions(1).StopIfTrue = False
ActiveCell.Offset(1, 0).Select
Range(ActiveCell, ActiveCell.End(xlToRight)).Select
Next
Application.ScreenUpdating = True
End Sub [code]
Any help is appreciated.
this worked perfectly.
Sub Conditions2()
Dim numrows As Long
Range("F2").Select
numrows = Range("F2", Range("F2").End(xlDown)).Rows.Count
With Range("F2", Range("F2").End(xlToRight)).Resize(numrows)
With .FormatConditions.Add(Type:=xlCellValue, Operator:=xlBetween, Formula1:="=$A2", Formula2:="=$B2")
.SetFirstPriority
With .Font
.Color = -16383844
.TintAndShade = 0
End With
With .Interior
.PatternColorIndex = xlAutomatic
.Color = 13551615
.TintAndShade = 0
End With
.StopIfTrue = False
End With
End With
End Sub

Formatting all empty rows using looping

Trying to find out how to loop the following VBA Macro in Excel. I need to find all the empty rows and format them (not delete or hide them as in other suggestions) as you can see in the existing code below:
Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Select
ActiveCell.Offset(, 0).Resize(1, 14).Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorDark1
.TintAndShade = -0.249946592608417
.PatternTintAndShade = 0
End With
I want to loop this until all empty rows have been formatted.
Try this:
Sub Test()
Dim sht As Worksheet, lastrow As Long
Set sht = ThisWorkbook.Worksheets("Sheet1")
lastrow = sht.Cells(sht.Rows.Count, "A").End(xlUp).Row
For i = 1 To lastrow
If Application.CountA(Range("A" & i & ":N" & i).EntireRow) = 0 Then
With Range("A" & i & ":N" & i).Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorDark1
.TintAndShade = -0.249946592608417
.PatternTintAndShade = 0
End With
End If
Next i
End Sub
Although I agree that your best solution is using conditional formatting :)
If the cells can later be edited and the formatting needs to be removed for no-longer-empty rows, then your one-time initial formatting isn't going to cut it. Best setup your generated worksheet (assuming you're generating that worksheet) with a conditional format.
You do that by creating FormatCondition objects, using the FormatConditions collection of your target Range:
Public Sub HighlightEmptyRows()
Dim target As Range
Set target = ActiveSheet.Range("A1:C10") 'change as needed
With target.FormatConditions
Dim condition As FormatCondition
Set condition = .Add(xlExpression, Formula1:="=COUNTA($A1:$C1)=0")
With condition
With .Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorDark1
.TintAndShade = -0.249946592608417
.PatternTintAndShade = 0
End With
End With
End With
End Sub
If no VBA code is generating that worksheet, then don't write VBA code for this
An extremely efficient, non-VBA solution would be to use conditional formatting and not use VBA at all.
Select the ENTIRE worksheet by clicking the corner between the Columns and row headers
Open Conditional Formatting Menu
Click on "New Rule"
Click "Use a formula to determine which cells to format"
Enter the following formula in the box: =COUNTBLANK(1:1)=16384
Select your desired formatting
The reason this works is because Excel is counting the number of blank cells in each row. Depending on the version of Excel being used, we already know there are 16384 columns in a row. So, if =countblank() returns a value other than your number, then it knows at least one cell has data in it.

Excel How to find duplicate cells or values in a row?

I have a dataset in which each row belongs to a unique person so what I want to do is that find duplicate values in each row.
I tried using conditional formatting but its very time consuming as I have to apply it to each individual row otherwise it will find duplicates among all rows not just one row.
Could you please suggest something that can help me it can be formula or vba or formula for conditional formatting.
I used macro recorder to create a macro and the results is below. If I can make it go through a range of rows and apply the formatting that could help
Sub DuplicatesRow1() ' ' DuplicatesRow Macro '
'
Rows("251:251").Select
Selection.FormatConditions.AddUniqueValues
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
Selection.FormatConditions(1).DupeUnique = xlDuplicate
With Selection.FormatConditions(1).Font
.Color = -16383844
.TintAndShade = 0
End With
With Selection.FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.Color = 13551615
.TintAndShade = 0
End With
Selection.FormatConditions(1).StopIfTrue = False
Rows("252:252").Select
Selection.FormatConditions.AddUniqueValues
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
Selection.FormatConditions(1).DupeUnique = xlDuplicate
With Selection.FormatConditions(1).Font
.Color = -16383844
.TintAndShade = 0
End With
With Selection.FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.Color = 13551615
.TintAndShade = 0
End With
Selection.FormatConditions(1).StopIfTrue = False
Rows("253:253").Select
Selection.FormatConditions.AddUniqueValues
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
Selection.FormatConditions(1).DupeUnique = xlDuplicate
With Selection.FormatConditions(1).Font
.Color = -16383844
.TintAndShade = 0
End With
With Selection.FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.Color = 13551615
.TintAndShade = 0
End With
Selection.FormatConditions(1).StopIfTrue = False
Range("E259").Select End Sub
I further worked on this and managed to come up with the following code which seems to be working for me. I am new to VBA and do not have enough experience so please let me know if my code can be improved further
Private Sub HighlightDuplicateRow(row As Integer)
Dim report As Worksheet
Set report = Excel.ActiveSheet
report.Cells(row, row).EntireRow.Select
Selection.FormatConditions.AddUniqueValues
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
Selection.FormatConditions(1).DupeUnique = xlDuplicate
With Selection.FormatConditions(1).Font
.Color = -16383844
.TintAndShade = 0
End With
With Selection.FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.Color = 13551615
.TintAndShade = 0
End With
Selection.FormatConditions(1).StopIfTrue = False
End Sub
Sub DuplicatesInEachRow()
Dim counter As Integer, limit As Variant
counter = 2
limit = InputBox("Give me last row number", "Highlight Duplicates in a Row")
If limit = "" Then Exit Sub
Do Until counter > limit
Call HighlightDuplicateRow(counter)
counter = counter + 1
Loop
End Sub
Here is a loop that will set a conditional format on each row. I used sheet and range references based on your sample data and code. You modify these to fit your exact data set.
I will also note that I am concerned about this causing performance issues in Excel if there are numerous rows, as the amount of Formats may seriously raise your file size and affect performance.
Sub LoopCF()
Dim ws As Worksheet
Set ws = Sheets("Sheet1")
'Dim lRow As Long
'lRow = ws.Range("A2").End(xlDown).Row 'will give row 200 as long as contiguous rows
Dim rng As Range, cel As Range
Set rng = ws.Range("B2:B200") 'ws.Range("B2:B" & lRow)
For Each cel In rng
With cel.Resize(1, 4)
.FormatConditions.AddUniqueValues
.FormatConditions(.FormatConditions.Count).SetFirstPriority
With .FormatConditions(1)
.DupeUnique = xlDuplicate
With .Font
.Color = -16383844
.TintAndShade = 0
End With
With .Interior
.PatternColorIndex = xlAutomatic
.Color = 13551615
.TintAndShade = 0
End With
.StopIfTrue = False
End With
End With
Next
End Sub

Conditional Formatting cells surrounding a given value

So I've set up a conditional formatting VBA macro to highlight two cells: The one with the given string, and the one next to it.
The data set is:
A1 B1
------------------------
PluginID NUM
Host ADDRESS
Severity High
Port PORT
Description DESCRIPTION
Solution SOLUTION
References CVE
The VBA code is:
Sub High2()
'
' High2 Macro
'
'
Columns("A:B").Select
Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
"=AND($B1=""High"",A1)"
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With Selection.FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.Color = 255
.TintAndShade = 0
End With
Selection.FormatConditions(1).StopIfTrue = False
End Sub
This highlights the cell with 'High' in it, and the cell to the left, 'Severity'.
If I change the "=AND($B1=""High"",A1)" line to "=AND($B2=""High"",A1)" then excel will highlight the 2 cells above it in red instead, i.e. Host.
Can anyone help me with highlighting the 4 cells above and 8 cells below the string search-term as well (i.e. the Port, Description, Solution and References cells)?
What you are actual doing if you "change the "=AND($B1=""High"",A1)" line to "=AND($B2=""High"",A1)"" is simply add a new rule. So this will be really the best approach. Adding as much rules as necessary.
Sub High2()
With Columns("A:B").Cells
.Range("A1").Activate
.FormatConditions.Delete
For i = 1 To 3 ' 3 above
.FormatConditions.Add Type:=xlExpression, Formula1:="=($B" & i & "=""High"")"
.FormatConditions(.FormatConditions.Count).SetFirstPriority
With .FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.Color = 255
.TintAndShade = 0
End With
.FormatConditions(1).StopIfTrue = False
Next
For i = 0 To 3 ' 4 below
.FormatConditions.Add Type:=xlExpression, Formula1:="=($B" & .Rows.Count - i & "=""High"")"
.FormatConditions(.FormatConditions.Count).SetFirstPriority
With .FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.Color = 255
.TintAndShade = 0
End With
.FormatConditions(1).StopIfTrue = False
Next
End With
End Sub
This could also be reached with only one rule:
=OR($B1048573:$B1048576="High", $B1:$B3="High")
But this will lead to bad performance since it is working as an array formula.

How to conditional format data in multiple columns by hardcoding what the column's header name is?

I'm looking to run a series of conditional formatting rules on two columns of data. I know I can select a column letter and all the cells in that columns, but to make my macro more full-proof I'd like for it to search for the column's header and run the formatting on the cells below the two specific headers.
I Currently used the Record Macro tool to see how this could potentially work, and this is my current setup. This macro does work, I would just like to make it full-proof and search through the worksheet for the specific column title names. I'd like to search a woorksheet for the column Titles "Header 1" and "Header 2".
Sub TwoColumnConditional()
Columns("K:AJ").Select
Selection.FormatConditions.Add Type:=xlTextString, String:="CONTAINSTEXT1", _
TextOperator:=xlContains
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With Selection.FormatConditions(1).Font
.Color = -16383844
.TintAndShade = 0
End With
With Selection.FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.Color = 13551615
.TintAndShade = 0
End With
Selection.FormatConditions(1).StopIfTrue = False
Selection.FormatConditions.Add Type:=xlTextString, String:="CONTAINSTEXT2", _
TextOperator:=xlContains
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With Selection.FormatConditions(1).Font
.Color = -16751204
.TintAndShade = 0
End With
With Selection.FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.Color = 10284031
.TintAndShade = 0
End With
End Sub
Try this:
Sub ApplyCF()
Dim ws As Worksheet
Dim rng As Range, fcel As Range, hrng As Range
Dim myheaders, header
Dim mycondition As String
myheaders = Array("Header 1", "Header 2")
Set ws = ThisWorkbook.Sheets("Sheet1")
With ws
Set rng = .Range("A1", .Range("A1").Offset(0 _
, .Columns.Count - 1).End(xlToLeft).Address)
'Debug.Print headers.Address
End With
For Each header In myheaders
Set fcel = rng.Find(header, rng.Cells(rng.Cells.Count))
If Not fcel Is Nothing Then
If hrng Is Nothing Then
Set hrng = fcel.EntireColumn
Else
Set hrng = Union(hrng, fcel.EntireColumn)
End If
End If
Next
'Debug.Print hrng.address
hrng.FormatConditions.Add Type:=xlTextString, String:="CONTAINSTEXT1", _
TextOperator:=xlContains
With hrng.FormatConditions(hrng.FormatConditions.Count)
With .Font
.Color = -16383844
.TintAndShade = 0
End With
With .Interior
.PatternColorIndex = xlAutomatic
.Color = 13551615
.TintAndShade = 0
End With
.StopIfTrue = False
End With
hrng.FormatConditions.Add Type:=xlTextString, String:="CONTAINSTEXT2", _
TextOperator:=xlContains
With hrng.FormatConditions(hrng.FormatConditions.Count)
With .Font
.Color = -16751204
.TintAndShade = 0
End With
With .Interior
.PatternColorIndex = xlAutomatic
.Color = 10284031
.TintAndShade = 0
End With
.StopIfTrue = False
End With
End Sub
I only assumed your headers are in the first row.
Adjust the code to suit.