I have a table from A1:C250. A1 is a merged cell that has the name of the table and A2,B2 and C2 are headers for the following rows. A3:A250, B3:B250 and C3:C250 is all data.
Some of the cells in B and C do not have any words, and I want to program a macro that will go through and highlight and delete the entire row if there is an empty cell in the table. I also want to make sure that the macro is not bound to only 250 rows, because I will be using this month to month and some months may have more or less than 250 data points.
Range("A3").Select
start = ActiveCell.Row
Selection.End(xlDown).Select
end = ActiveCell.Row
rng = Application.Range("A3:C"& end )
For Each cel In rng.Cells
If isEmpty(cel) Then
cel.Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 65535
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Else
'Do nothing
End If
Next cel
Related
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
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.
I would like write a VBA code to select a group of cells that has the same value and colour it.
MySpreadSheet
For Row A, Staff ID, are the same, for the same person, I intend to scan through them and if they are the same, fill the cells with the light blue colour you see in the picture above, for Column A to MaxColumn of Current Region.
I have a drafted a code to do that but it does nothing when I run it. Any help will be appreciated:
Sub ActualColouring()
Dim SerialNumber As Integer
SerialNumber = 2 'this variable will be assign to the rows, ignore the header, start from 2
Do While Cells(1, SerialNumber).Value <> "" 'keep looping as long as cell is not blank
If Cells(1, SerialNumber).Value = Cells(1, SerialNumber + 1).Value Then 'if the value of the cell is the same as the cell below, then
Cells(1, SerialNumber).Select 'then select it
With Selection.Interior 'this line is the start of the fill colouring
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent1
.TintAndShade = 0.799981688894314
.PatternTintAndShade = 0
End With 'end of fill colouring function
End If
SerialNumber = SerialNumber + 1 'move to the next cell
Loop 'loop until the end of current region
End Sub
Qualify the objects and avoid select
Sub ActualColouring()
Dim ws as Worksheet
Set ws = ThisWorkbook.Worksheets("mySheet") ' change name as needed
With ws
Dim SerialNumber As Long, lRow as Long
lRow = .Range("A" & .Rows.Count).End(xlup).Row
For SerialNumber = 2 to lRow
If .Cells(1, SerialNumber).Value = .Cells(1, SerialNumber + 1).Value Then
With .Cells(1, SerialNumber).Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent1
.TintAndShade = 0.799981688894314
.PatternTintAndShade = 0
End With
End If
Next
End With
End Sub
i am a newbie in VBA, so i come across with several issues.
I have a dataset that looks like this:
I have to compare column A with columns B,C,D,E and F and then color the fonts of the cells in columns B:F under these conditions:
If cells in column A are equal with the cells in columns B:F, paint their font orange.
If cells in column A are higher than the cells in columns B:F, paint their font red.
If cells in column A are lower than the cells in columns B:F, paint their font green.
If the absolute difference between column A and the rest columns (B:F) is less than 1, paint their font orange.
I have tried to write a simple macro and all conditions are met except the 4th.
Here is my attempt.
Sub ConditionalFormating()
Dim i, j, a As Double
a = 0.99
i = 2
j = 2
For j = 1 To 6
For i = 2 To 10
ActiveSheet.Cells(i, j).Select
If ActiveSheet.Cells(i, j) - ActiveSheet.Cells(i, 1) >= a Then
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = RGB(255, 156, 0)
.TintAndShade = 0
.PatternTintAndShade = 0
End With
End If
If ActiveSheet.Cells(i, j) - ActiveSheet.Cells(i, 1) <= a Then
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = RGB(255, 156, 0)
.TintAndShade = 0
.PatternTintAndShade = 0
End With
End If
If ActiveSheet.Cells(i, j) > ActiveSheet.Cells(i, 1) Then
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = RGB(0, 255, 0)
.TintAndShade = 0
.PatternTintAndShade = 0
End With
End If
If ActiveSheet.Cells(i, j) < ActiveSheet.Cells(i, 1) Then
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = RGB(255, 0, 0)
.TintAndShade = 0
.PatternTintAndShade = 0
End With
End If
Next
Next
End Sub
Could anyone help me? I cannot understand why the 4th condition is not met when all others are.
Thank you in advance!
To color the font, you have to use the Font property of Range, like: Selection.Font.Color=RGB(255,128,0).
you could try this (commented) code:
Option Explicit
Sub ConditionalFormating()
Dim cell As Range, cell2 As Range, dataRng As Range
Dim colOrange As Long, colRed As Long, colGreen As Long, col As Long
colOrange = RGB(255, 156, 0)
colRed = RGB(255, 0, 0)
colGreen = RGB(0, 255, 0)
With Worksheets("CF") '<--| reference the relevant worksheet (change "CF" to your actual worksheet name)
Set dataRng = Intersect(.Columns("B:F"), .UsedRange)
For Each cell In .Range("A2", .Cells(.Rows.Count, 1).End(xlUp)).SpecialCells(xlCellTypeConstants) '<-- loop through its column "A" not empty cells from row 1 down to last not empty one
If WorksheetFunction.CountA(Intersect(dataRng, cell.EntireRow)) > 0 Then ' if current row has data
For Each cell2 In Intersect(dataRng, cell.EntireRow).SpecialCells(xlCellTypeConstants) ' loop through current column "A" cell row not empty cells
Select Case True '<-- check the current datum against the following conditions
Case cell2.Value = cell.Value Or Abs(cell.Value - cell2.Value) < 1 'if current datum equals corresponding value in column "A" or their absolute difference is lower than 1
col = colOrange
Case cell2.Value < cell.Value 'if current datum is lower then corresponding value in column "A"
col = colRed
Case cell2.Value > cell.Value 'if current datum is higher then corresponding value in column "A"
col = colGreen
End Select
With cell2.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = col
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Next cell2
End If
Next cell
End With
End Sub
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: