Is there a function to get the activecell formatting? e.g. background color, font, font color, cell border, font size etc.
I want to update the format of an entire worksheet based on a formatted cell before action (i.e. the format I want to change) by another formatted cell (i.e. the format I want to apply).
Sub Rep_all_format()
Dim fmt_bef As CellFormat
Dim fmt_aft As CellFormat
Dim rngReplace As Boolean
Dim msg As String
Dim Sh As Worksheet
Dim Rg As Range
Dim ppos1 As Range
Dim ppos2 As Range
Dim Find As String
Dim Remplace As String
Set ppos1 = Application.InputBox(Prompt:="Select the cell format you wanna change", Title:="Remplace", Default:=ActiveCell.Address, Type:=8)
Set ppos2 = Application.InputBox(Prompt:="Select the cell format you wanna apply", Title:="Select", Type:=8)
Find = ppos1.FormatConditions 'this is theorical I do not know the function
Remplace = ppos2.FormatConditions 'this is theorical I do not know the function
Application.ScreenUpdating = False
Set fmt_bef = Application.FindFormat
Set fmt_aft = Application.ReplaceFormat
For Each Sh In ThisWorkbook.Worksheets
Set Rg = Sh.UsedRange
With fmt_bef
.Clear
.FormatConditions = Find
End With
With fmt_aft
.Clear
.FormatConditions = Remplace
End With
Rg.Replace What:="", Replacement:="", _
SearchFormat:=True, ReplaceFormat:=True
Next
fmt_bef.Clear
fmt_aft.Clear
Application.ScreenUpdating = True
MsgBox ("The desired format has been applied through all the workbook")
End Sub
Assuming, from the code that you have provided, that your cell has been formatted using Conditional Formatting, you need to access is the Range.DisplayFormat property.
Note that I showed only some of the formatting options for a cell. There is documentation online for other formatting options (eg other borders, numberformat, etc) but this should get you started.
For example:
Option Explicit
Sub foo()
Dim R As Range, C As Range
Dim fc As FormatCondition
Set R = Range(Cells(1, 1), Cells(5, 1))
For Each C In R
With C.DisplayFormat
Debug.Print .Interior.Color
Debug.Print .Font.Name
Debug.Print .Font.Color
Debug.Print .Borders(xlEdgeLeft).LineStyle ' etc
Debug.Print .Font.Size
End With
Stop
Next C
End Sub
If the cell has been formatted manually, or directly using code, then just access the various properties directly, not using the DisplayFormat property eg:
For Each C In R
With C
Debug.Print .Interior.Color
Debug.Print .Font.Name
Debug.Print .Font.Color
Debug.Print .Borders(xlEdgeLeft).LineStyle ' etc
Debug.Print .Font.Size
End With
Stop
Next C
What you are looking for are the Range.Interior and Range.Font properties etc.
You can see some examples in the links below:
https://learn.microsoft.com/en-us/office/vba/api/excel.font(object)
https://learn.microsoft.com/en-us/office/vba/api/excel.interior(object)
https://learn.microsoft.com/en-us/office/vba/api/excel.border(object)
Related
So every cell that has a value of 0, that row will be hidden. And any value that is outside the minimum and maximum values will be red.
How to identify red color but active (not hidden) with macro? because I used "range. displayformat. interior. color = vbred", the cells are red but hidden are also counted. Thanks.
Try this, the visible cells will be formatted
Set rng = Range("Your range").SpecialCells(xlCellTypeVisible)
rng = ActiveCell.DisplayFormat.Interior.Color = vbRed
Here is the sample code for the "if" condition that you ask for.
Sub Highlight_Greater_Than()
Dim ws As Worksheet
Dim Rng As Range
Dim ColorCell As Range
Set ws = Worksheets("Name")
Set rng = Range("Your range").SpecialCells(xlCellTypeVisible)
'rng = ActiveCell.DisplayFormat.Interior.Color = vbRed
Set ColorCell = rng
For Each ColorCell In Rng
If ColorCell.Value > 1 Then " You can define here" "greater, smaller, equal etc.."
ColorCell.Interior.Color = vbred
Else
ColorCell.Interior.ColorIndex = "vb(colour)or" xlNone
End If
Next
End Sub
I am trying to write the VBA Code for checking if the formula exists in a range of cells. Below is my query which is somehow not working(The cells with formulas are not turning red). Can anyone please help me out.
Sub Test()
Dim LResponse As Integer
Set rr = Application.InputBox( _
prompt:="Select a range On this worksheet", _
Type:=8)
If rr.HasFormula = TRUE Then
rr.Interior.Color = vbRed
End If
End Sub
Edit: I tried looping too
Sub Test()
Set rr = Application.InputBox( _
prompt:="Select a range On this worksheet", _
Type:=8)
For Each cell In Range(rr)
If cell.HasFormula = TRUE Then
cell.Interior.Color = vbRed
End If
Next
End Sub
From the Range.HasFormula docs:
True if all cells in the range contain formulas; False if none of the cells in the range contains a formula; null otherwise.
Its return value is determined by all the cells having or not having formulas. If only some have formulas, then it is null.
To fix your issue, use a loop over each individual cell:
Dim rng as Range
For Each rng in rr
If rng.HasFormula Then
rng.Interior.Color = vbRed
End If
Next
EDIT: In your loop attempt, drop the Range call:
For Each cell in rr
EDIT 2: You can also use Range.SpecialCells:
On Error Resume Next '<~ an error will occur if there are no formula cells
Dim rng as Range
Set rng = rr.SpecialCells(xlCellTypeFormulas)
On Error GoTo 0
If Not rng Is Nothing Then
rng.Interior.Color = vbRed
End If
I have a code that's not working yet.
It is supposed to open an input window where you can enter a text.
Then it should open an window where you can enter the range.
After both entries the whole workbook should be searched and the whole cell where the partial text is located should be marked bold.
If the cell contains more text than the one you are looking for, it should be marked bold.
Example in the cell there is the text:
"Export Area Asia"
If I only enter "Export Area" in the input window, the cell containing "Export Area Asia" should be marked completely bold.
Here is my code so far:
Sub Zelle_Fett_Wenn_best_Inhalt_Input_Box()
Dim Filtertext As String
Dim ws As Worksheet
Dim aRange As Range
On Error Resume Next
Set aRange = Application.InputBox(prompt:="Enter range", Type:=8)
If aRange Is Nothing Then
MsgBox "Operation Cancelled"
Else
aRange.Select
End If
Filtertext = InputBox("Enter Text")
For Each ws In Worksheets
ws.Select
x = ActiveSheet.UsedRange.Rows.Count
Rows.Select
If Cells.Value Like Filtertext Then
Selection.Font.Bold = True
Else
Selection.Font.Bold = False
End If
Next ws
End Sub
Maybe somebody would be so nice to correct it so that it works.
Thanks a lot and cheers
Tom
So as per my comment, I'd advise against using .Select or UsedRange. Instead get your last used row and column dynamically. Furthermore, you are missing wildcards in your Like operator plus you'd want to iterate over your whole Range object.
Next, I'd say you could skip iteration and either use conditional formatting OR use ReplaceFormat, for example:
Sub Test()
Dim lr As Long, lc As Long, rng As Range, ws As Worksheet, FilterText As String
FilterText = InputBox("Enter Text")
If FilterText = "" Then Exit Sub
For Each ws In ThisWorkbook.Worksheets
'Get last used row and column
lr = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
lc = ws.Cells(1, ws.Columns.Count).End(xlToLeft).Column
'Set your range object
Set rng = ws.Range(ws.Cells(1, 1), ws.Cells(lr, lc))
'Set your ReplaceFormat
With Application.ReplaceFormat
.Clear
.Font.Bold = True
End With
'Replace formatting to cells with right criteria
rng.Font.Bold = False
rng.Replace What:="*" & FilterText & "*", Replacement:="", SearchFormat:=False, ReplaceFormat:=True
Next ws
End Sub
I left out aRange since I noticed you never even use it.
I have written a short Macro to change cells of a given colour to another colour in a workbook. This code throws no errors however it simply does nothing.
I have already tested the colour codes to see if they are correct using MsgBox ActiveCell.DisplayFormat.Interior.color
Option Explicit
Sub Recolour()
Application.ScreenUpdating = False
Dim Sheet As Worksheet
Dim Rng As Range
Dim OldColour As Variant
Dim NewColour As Variant
Dim Cell As Range
Set Rng = ActiveSheet.Range("A1:Y457")
OldColour = 128
NewColour = RGB(134, 38, 51)
For Each Sheet In ThisWorkbook.Worksheets
For Each Cell In Rng.Cells
If ActiveCell.DisplayFormat.Interior.Color = OldColour _
Then _
Set ActiveCell.DisplayFormat.Interior.Color = NewColour _
Else
Next Cell
Next Sheet
Application.ScreenUpdating = True
End Sub
This is probably something simple and daft however I need to ask.
DisplayFormat is read-only. If you want to change the property, you need to drop DisplayFormat. Also, if you are using For each Cell, then you should refer to Cell, not ActiveCell.
For Each Sheet In ThisWorkbook.Worksheets
For Each Cell In Rng.Cells
If Cell.Interior.color = OldColour Then
Cell.Interior.color = NewColour
End if
Next Cell
Next Sheet
You only need to Set object variables in VBA, your if statement is also problematic. Try:
For Each Sheet In ThisWorkbook.Worksheets
For Each Cell In Rng.Cells
If ActiveCell.DisplayFormat.Interior.color = OldColour Then
ActiveCell.DisplayFormat.Interior.color = NewColour
End if
Next Cell
Next Sheet
I'm creating an excel file with column A to H are mandatory cells.
This excel file will be passing around for input.
So, I would like to highlight the empty cells as a reminder.
I have written the following code...
Sub Highlight_Cell()
Dim Rng As Range
For Each Rng In Range("A2:H20")
If Rng.Value = "" Then
Rng.Interior.ColorIndex = 6 ‘yellow
Else
Rng.Interior.ColorIndex = 0 'blank
End If
Next Rng
MsgBox "Please fill in all mandatory fields highlighted in yellow."
End Sub
However, I would like to set the range from A2 to the last row that contains data within column A to H.
Also, display the message box only when empty cell exist.
Could you please advise how should I amend?
Million Thanks!!!
This is a VBA solution that prevents the user from saving until the desired range is filled (acknowledging Gserg's comment that that the last row is one that has at least one cell entered)
In the second portion you can either add your sheet index directly, Set ws = Sheets(x) for position x, or Set ws = Sheets("YourSheet") for a specific sheet name
The code will only highlight truly blank cells within A to H of this sheet till the last entered cell (using SpecialCells as a shortcut). Any such cells will be selected by the code on exit
Put this code in the ThisWorkbook module (so it fires whenever the user tries to close the file)
Private Sub Workbook_BeforeClose(Cancel As Boolean)
bCheck = False
Call CheckCode
If bCheck Then Cancel = True
End Sub
Put this code in a standard module
Public bCheck As Boolean
Sub CheckCode()
Dim ws As Worksheet
Dim rng1 As Range
Dim rng2 As Range
bCheck = False
'works on sheet 1, change as needed
Set ws = Sheets(1)
Set rng1 = ws.Columns("A:H").Find("*", ws.[a1], xlValues, xlWhole, xlByRows)
If rng1 Is Nothing Then
MsgBox "No Cells in columns A:H on " & ws.Name & " file will now close", vbCritical
Exit Sub
End If
Set rng2 = ws.Range(ws.[a1], ws.Cells(rng1.Row, "H"))
On Error Resume Next
Set rng2 = rng2.SpecialCells(xlBlanks)
On Error GoTo 0
If rng2 Is Nothing Then Exit Sub
bCheck = True
rng2.Interior.Color = vbYellow
MsgBox "Please fill in all mandatory fields on " & ws.Name & " highlighted in yellow", vbCritical, "Save Cancelled!"
Application.Goto rng2.Cells(1)
End Sub