I have pieces of the code figured out, but what I can't quite get is how to parse the column and then select the first row in that column.
The objective is to color the header cell of a column, if the selected cell has a formula. The piece I'm looking for is
Sub ColorFormulaHeaders()
Dim oWkbk As Workbook
Dim oWkst As Worksheet
Dim oRng As Range
For Each oRng In Selection.Cells
If oRng.HasFormula Then
'Select Column Header
With Selection
.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent6
.TintAndShade = 0
.PatternTintAndShade = 0
End With
End If
End Sub
You have the right idea. Here is one way to get to the column header:
Sub ColorFormulaHeaders()
Dim oWkbk As Workbook
Dim oWkst As Worksheet
Dim oRng As Range
For Each oRng In Selection.Cells
If oRng.HasFormula Then
With oRng.EntireColumn.Cells(1).Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent6
.TintAndShade = 0
.PatternTintAndShade = 0
End With
End If
Next oRng
End Sub
You can use similar technique to get a row label for a cell in some row if the label is in column A for that cell.
Related
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 am new in VBA and a bit struggling with it.
I am creating a report. In the report I have drop down list with a Flowers, let’s say Lilly, Rose Etc. So when I select Rose I want some certain cells gets colour. I don’t want use conditional formatting as I need keep spreadsheet as low size as possible.
So far I got
Private Sub workbook_sheetchange(ByVal Sh As Object, ByVal Targer As Rang
Select Case Range("B2")
Case " Rose"
Application.Goto Reference:="Header"
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent6
.TintAndShade = -0.249977111117893
.PatternTintAndShade = 0
End With
Application.Goto Reference:="Row"
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent6
.TintAndShade = -0.249977111117893
.PatternTintAndShade = 0
End With
Application.Goto Reference:="Fill"
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent6
.TintAndShade = 0.599993896298105
.PatternTintAndShade = 0
End With
End Select
End Sub
Thank you for any help!
you may be after this:
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
If Target.Address <> "$B$2" Then Exit Sub '<--| exit if "changed" cell is not "B2"
With Sh '<--| reference sheet with "changed" cell
Select Case .Range("B2").Value '<--| act with respect to B2 cell current value
Case "Rose"
With .Range("Header").Interior '<--| reference the specific named range instead of using 'Application.GoTo' method and 'Selection' object
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent6
.TintAndShade = -0.249977111117893
.PatternTintAndShade = 0
End With
With .Range("Row").Interior '<--| reference the specific named range instead of using 'Application.GoTo' method and 'Selection' object
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent6
.TintAndShade = -0.249977111117893
.PatternTintAndShade = 0
End With
With .Range("Fill").Interior '<--| reference the specific named range instead of using 'Application.GoTo' method and 'Selection' object
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent6
.TintAndShade = 0.599993896298105
.PatternTintAndShade = 0
End With
End Select
End With
End Sub
which could be more effectively refactored to:
Option Explicit
Private Sub workbook_sheetchange(ByVal Sh As Object, ByVal Target As Range)
If Target.Address <> "$B$2" Then Exit Sub '<--| exit if "changed" cell is not "B2"
With Sh '<--| reference sheet with "changed" cell
Select Case .Range("B2") '<--| act with respect to B2 cell current value
Case "Rose"
FormatCell Union(.Range("Header"), .Range("Row"), .Range("Fill")), _
xlSolid, _
xlAutomatic, _
xlThemeColorAccent6, _
-0.249977111117893, _
0 '<--| reference all listed named ranges and format their 'Interior' object with passed properties
.Range("Fill").Interior.TintAndShade = 0.599993896298105 '<--| change only "Fill" named range 'Interior' 'TintAndShade' property
End Select
End With
End Sub
Sub FormatCell(cell As Range, pttrn As XlPattern, pttrnClrIndx As XlColorIndex, thmClr As XlThemeColor, tntAndShd As Single, pttrnTntAndShd As Variant)
With cell.Interior
.pattern = pttrn
.PatternColorIndex = pttrnClrIndx
.ThemeColor = thmClr
.TintAndShade = tntAndShd
.PatternTintAndShade = pttrnTntAndShd
End With
End Sub
Why are you concerned about file size? I have created a workbook that does exactly as you require using conditional formatting and and the file size is 10.5Kb!!!
If you REALLY want to do this in VBA:
1 - Detect if B2 has changed by using the worksheet change event
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Application.Intersect(Range("B2"), Range(Target.Address)) Is
MsgBox "Cell B2 has been changed"
End If
End Sub
2 - Test each cell in your data against your dropdown box. I have assumed your data is in range A1 to A10 for this example.
For Row = 1 To 10
If Range("A" & Row).Value = Range("B2").Value Then
'Colour your cell
Else
'Clear the colour from your cell
End If
Next Row
Hopefully the above gives you a start.
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 trying to format cells in excel
Following is the code I have:
Range("A1:F1").Select
Selection.Font.Bold = True
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 65535
.TintAndShade = 0
.PatternTintAndShade = 0
End With
I need to repeat the formatting steps multiple times for different ranges, can I call a subroutine instead?
Here is one way to apply the format to a number of ranges in a loop:
Sub dural()
Dim r As Range
ary = Array(Range("A1:Z1"), Range("A3:Z3"), Range("A7:Z7"))
For i = LBound(ary) To UBound(ary)
Call FFormat(ary(i))
Next
End Sub
Sub FFormat(rIn As Variant)
rIn.Font.Bold = True
With rIn.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 65535
.TintAndShade = 0
.PatternTintAndShade = 0
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: