I am creating a button for a toolbar to change colors from white background, black font, to white font black background within a selected area. (will be used for tables like P&L's, balance sheets etc in accounting).
But I also need some functionality in the button that looks through the cells that are selected, locates any existing borders and turns them white. Perhabs by having a boolean or something checking if the background color is black, and then turning existing borders white. I does not need to make any new borders, only invert the colors of existing ones.
This is what i've already have, but it just makes all borders white:
Dim Background As Boolean
Dim cel As Range
Dim selectedRange As Range
Set selectedRange = Application.Selection
With Selection.Borders
For Each cel In selectedRange.Cells
If cel.Borders(xlEdgeTop).LineStyle <> xlLineStyleNone Then
.Color = RGB(255, 255, 255)
End If
If cel.Borders(xlEdgeBottom).LineStyle <> xlLineStyleNone Then
.Color = RGB(255, 255, 255)
End If
Next cel
End With
Hope you're able to help me out :)
You are applying the color to every border in the Selection.Borders collection because that's the With variable. Just set the color of cel.Borders(xlEdgeTop)
Dim cel As Range
Dim selectedRange As Range
Set selectedRange = Application.Selection
For Each cel In selectedRange.Cells
With cel.Borders
If .Item(xlEdgeTop).LineStyle <> xlLineStyleNone Then
.Item(xlEdgeTop).Color = vbWhite
End If
If .Item(xlEdgeBottom).LineStyle <> xlLineStyleNone Then
.Item(xlEdgeBottom).Color = vbWhite
End If
End With
Next cel
You could also use two With blocks: With cel.Borders(xlEdgeTop) and With cel.Borders(xlEdgeBottom) and then just use .LineStyle and .Color. You could also skip the With block altogether because it really doesn't save much here (cel.Borders -> .Item).
Related
I am currently trying to change Cells across several worksheets in a Workbook which have a specific colour to No Fill. Here is the code I am using below. Can anyone help?
Sub YellowFillToNoFill()
'RGB(246, 244, 150) Yellow Colour To change to no Fill
'PURPOSE: Change any cell with a Yellow fill color to a No fill color
Dim cell As Range
'Optimize Code
Application.ScreenUpdating = False
'Ensure Cell Range Is Selected
If TypeName(Selection) <> "Range" Then
MsgBox "Please select some cells before running"
Exit Sub
End If
'Loop Through Each Cell
For Each cell In ActiveSheet.UsedRange 'Can also use Range("C1,C2" etc.) instead of
'Selection.Cells' or 'ActiveSheet.UsedRange'
If cell.Interior.Color = RGB(246, 244, 150) Then
cell.Interior.Color = xlNone
End If
Next
End Sub
To reset the value, use Use cell.Interior.ColorIndex = xlNone
Color defines the color that is displayed. It's a long value that contains the RGB-value of the color.
ColorIndex is the index into the table of predefined colors (the table of colors you see when you select a color in Excel). The special value xlNone (-4142) removes any color setting.
I have a value in the cell V6 and i want it to change its color if the color of a specific sheet tab called "Test" is red (vbRed). I have tried a code but it doesn't seem to change the color of the text in the cell. I was wondering what is wrong and what could be done to fix it.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim ws As Worksheet
Set ws = ThisWorkbook.Sheets("Test")
If ws.Tab.ColorIndex = vbRed Then
Range("v6").Font.Color = vbRed
End If
End Sub
One way to do this is to use a Boolean variable (I called my variable colortest) to test if the tab color is equal to vbRed or not.
this sample code turns the font color red if the tab is vbRed, and turns the font color black if the tab is any other color than vbRed.
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim ws As Worksheet, colortest As Boolean
Set ws = ThisWorkbook.Sheets("Test")
colortest = Sheets("Test").Tab.Color = vbRed
If colortest = True Then
Range("v6").Font.Color = vbRed
ElseIf colortest = False Then
Range("v6").Font.Color = vbBlack
End If
End Sub
`
Note: I used Worksheet_SelectionChange so the code runs as soon as you click out of cell vs having to edit a cell as in Worksheet_Change
My code to strike through blue colored visible rows after filtering a table isn't working as expected
Public Sub EditRows()
Dim rng As Range
Dim cell As Range
Dim Database As Worksheet
Set Database = ThisWorkbook.Worksheets(1)
Set rng = Database.AutoFilter.Range
Set rng = rng.Offset(1, 0).Resize(rng.Rows.count - 1, 1)
'Loop Through each visible row after filtering
For Each cell In rng.Columns(9).Cells.SpecialCells(xlCellTypeVisible)
'Strike through entire row if row is either these two shades of blue
If cell.Interior.Color = RGB(0, 112, 192) Or cell.Interior.Color = vbBlue Then
cell.Rows(rng).Font.Strikethrough = True
End If
Next cell
End Sub
Edit: Sorry for the confusion, the IF condition was based on the font color of that column instead of the interior color.
For Each cell In rng.Columns(9).Cells.SpecialCells(xlCellTypeVisible)
If cell.Font.Color = vbBlue Then
cell.EntireRow.Font.Strikethrough = True
End If
Next cell
4 things:
(1) First thing you need to check is if your code is dealing with the correct range of data. Check if the variable rng contains the range you are expecting, eg by putting a statement Debug.Print rng.address after the assignment. If that is okay, check if the loop if using the cells you are expecting, for example by putting a Debug.Print cell.addess inside the loop.
(2) If you are sure the loop handles the cells you are interested in, check if the blue you are checking is the correct blue. Set a breakpoint to your if-statement, execute the loop until a cell is hit that is blue (check the address) and check the interior-color in the debugger. vbBlue is 16711680 (&HFF0000), your manually defined blue color is 12611584 (&HC07000). If the color matches, it should enter the If-statement.
(3) If the cells are blue because of conditional formatting, check cell.DisplayFormat.Color rather than cell.Interior.Color
(4) I assume that you want to strikethrough the cell having blue color, so the statement should be simply cell.Font.Strikethrough = True.
I am trying to write a macro capable of grouping rows based on their fill color. The issue is: my macro does nothing. It neither groups the rows nor throws an error. I am not sure what I am missing.
Option Explicit
Sub RowGrouper()
Dim rng As Range
Dim lastRow As Long
lastRow = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row
For Each rng In Range(Cells(10, 1), Cells(lastRow, 1)).Cells
If rng.Interior.ColorIndex = (xlNone Or RGB(255, 255, 238)) Then
'255,255,238 is the light yellow color in the images below
rng.Rows.Group
End If
Next
End Sub
Any help you can lend me is appreciated.
Here is a picture of the rows I am trying to group and one of them grouped as they should be:
Edit: With the help of Michael Murphy, I am getting closer, but now it is only group the light yellow rows, rather than all of the white and light yellow rows.
Your problem is here:
If rng.Interior.ColorIndex = (xlNone Or RGB(255, 255, 238)) Then
you'll need to change this to
If rng.Interior.ColorIndex = xlNone Or rng.Interior.Color = RGB(255, 255, 238) Then
In the future you should try stepping through your code line-by-line. You'd be able to see that your If always evaluates to False no matter what color your cell is.
I have sequential columns of data, each has a list of ID codes.
I would like to highlight duplicates across columns, but in order to keep everything straight it would be amazing if I could highlight each duplicate in a different color.
i.e. If 12345 appears in columns 2, 4, and 8, and 23456 appears in 1, 2, and 4, then I'd like to have 12345 highlighted in red in all locations, and 23456 highlighted in yellow in all locations. Ideally then each subsequent duplicate would also need to be highlighted in a new color.
I'm wondering if there's any way to set this up in excel using built in functionality. If not, I promise I'll post a guide displaying how to do it with VBA, but I wanted to check first before I go through all that work.
You can try this VBA approach.
Sub ColorsDuplicateNum()
Dim Rng As Range
Dim Cel As Range
Dim Cel2 As Range
Dim Colors As Long
Set Rng = Worksheets("Sheet1").Range("A1:K500")
Rng.Interior.ColorIndex = xlNone
Colors = 3
For Each Cel In Rng
If WorksheetFunction.CountIf(Rng, Cel) > 1 And Cel.Interior.ColorIndex = xlNone Then
Set Cel2 = Rng.Find(Cel.Value, LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=False, SearchDirection:=xlNext)
If Not Cel2 Is Nothing Then
Firstaddress = Cel2.Address
Do
Cel.Interior.ColorIndex = Colors
Cel2.Interior.ColorIndex = Colors
Set Cel2 = Rng.FindNext(Cel2)
Loop While Firstaddress <> Cel2.Address
End If
Colors = Colors + 1
End If
Next
End Sub
Adjust Range("A1:K500") to your range of cells. Colors are starting from 3 in order to skip Black and White color.