I need a macro that puts a border in a range of cells from A to F, based on the formatting in the A column. In the A column, cells can be merged with multiple cells below it, or can be just a single cell. I have written a VBA code to put a border around the non-blank cells in column A, but dont know how to expand it to the other 5 columns (from B to F). See the pictures to better understand what I have written and what I need.
How the Data looks like:Data
What my code does:WhatMyCodeDoes
What I want it to do:WhatIWantItToDo
My code:
Sub Borders()
Dim linestyle As Variant, line As Variant
Range("A1").Select
Do While ActiveCell.Address <> Range("A65536").End(xlUp).Offset(1, 0).Address
If ActiveCell.Value > 0 Then
linestyle = Array(xlDiagonalDown, xlDiagonalUp, xlInsideVertical, xlInsideHorizontal)
line = Array(xlEdgeLeft, xlEdgeTop, xlEdgeBottom, xlEdgeRight)
For I = 0 To UBound(linestyle)
Selection.Borders(linestyle(I)).linestyle = xlNone
With Selection.Borders(line(I))
.linestyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
Next I
Else
End If
ActiveCell.Offset(1, 0).Select
Loop
End Sub
You may change only two lines and will be OK.
'Range("A1").Select
Range("A1").Resize(1, 6).Select
' ...
'ActiveCell.Offset(1, 0).Select
ActiveCell.Offset(1, 0).Resize(1, 6).Select
Related
I am trying to exercise Levenshtein Distance in Excel. To fill the cells, we need to consider the minimum of three cells (left, up-left, and up). It is easy to find minimum of those three if they were highlighted.
I want to highlight those three cells whenever I put my cursor on any empty cell. Just like shown on image below. When I put my cursor on C3; B2, B3, and C2 should be higlighted.
I found a VBA script. But it higlightes the entire row and column of cursor cell. I am not familiar with VBA, therefore can't modify rows and columns to my way.
Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
'Update 20200430
Static xRow
Static xColumn
If xColumn <> "" Then
With Columns(xColumn).Interior
.ColorIndex = xlNone
End With
With Rows(xRow).Interior
.ColorIndex = xlNone
End With
End If
pRow = Selection.Row
pColumn = Selection.Column
xRow = pRow
xColumn = pColumn
With Columns(pColumn).Interior
.ColorIndex = 6
.Pattern = xlSolid
End With
With Rows(pRow).Interior
.ColorIndex = 6
.Pattern = xlSolid
End With
End Sub
this is what it does
A Worksheet SelectionChange: Highlight Cells
Sub Worksheet_SelectionChange(ByVal Target As Range)
With Target.Cells(1)
If .Row = 1 Then Exit Sub
If .Column = 1 Then Exit Sub
If IsEmpty(.Cells) Then
.Worksheet.UsedRange.Interior.ColorIndex = xlNone
Union(.Offset(-1, -1).Resize(2), .Offset(-1)) _
.Interior.Color = vbYellow
End If
End With
End Sub
I have a sheet where in column B the cells are merged with the row below. In the rest of the columns the rows are not merged.
I want to add a VBA code that draws a line across the bottom of the entire row along the bottom of the merged cells. It's as if I wanted to draw a bottom border every other row for all columns (except B where each merged cell would have the bottom border). I have tried using the following code but the border is not drawn under the merged cells
Sub FormatTest()
With Sheets("Test")
With .Range("$B:$Z")
.FormatConditions.Add xlExpression, Formula1:="=mod(row(),2)=0"
With .FormatConditions(1).Borders(xlBottom)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlThin
End With
.FormatConditions(1).StopIfTrue = False
End With
End With
End Sub
Here is an example of what i want to achieve
I want to achieve this with conditional formatting because the number of rows will change from time to time and i don't want to have borders on empty cells.
The photo is just an example because there are many rows and on different sheets I will have a different number of columns so I just want to apply it to the whole row... Can anyone help?
You can try using something along these lines:
(Just might need to tinker with the row = 1 to get the correct starting position)
Dim row As Long
Dim lastRow As Long
Dim lCol As Long
Dim letter As String
With ThisWorkbook.Worksheets("your sheet name")
' clear previous borders
.Range("A5:ZZ30000").Borders.Linestyle = xlNone
' add new borders
lastRow = .Cells(.Rows.Count, "B").End(xlUp).Row
lCol = .Cells(1, .Columns.Count).End(xlToLeft).Column ' checks row 1 for last col
letter = Split(.Cells(1, lCol).Address, "$")(1)
For row = 1 To lastRow+1 Step 2
With .Range("B" & row & letter & row).Borders(xlBottom)
.LineStyle = xlContinuous
.Weight = xlThin
End With
Next
End With
I need to highlight a cell in column B if it is less than value in column F. For example if cell B2 is 10 and F2 is 20, B2 should be red. However in column B there are blank cells i do not want these highlighted. For example B6 is blank but F6 is 10. In my code B6 become red as well.
Also how would i highlight a cell in the same row that is already highlighted. For example, if B2 is highlighted, highlight F2.
My code is below:
Sub threecf()
Dim rg As Range
Dim cond1 As FormatCondition, cond2 As FormatCondition
Set rg = Range("B2", Range("B2").End(xlDown))
'clear any existing conditional formatting
rg.FormatConditions.Delete
'define the rule for each conditional format
Set cond1 = rg.FormatConditions.Add(xlCellValue, xlLess, "=f2")
Set cond2 = rg.FormatConditions.Add(xlCellValue, xlEqual, "=isempty(f2)")
'define the format applied for each conditional format
With cond1
.Interior.Color = vbRed
.Font.Color = vbWhite
End With
With cond2
.Interior.Color = vbWhite
.Font.Color = vbWhite
End With
End Sub
As mentioned in my comment, use formulas. No need to use VBA
Easiest Way (Recommended Way)
I recommend this way because it takes into account new rows that are being added.
Select Col B
Select Home Tab | Conditional formatting | New Rule | Use a formula to determine which cells to format
Enter the formula =AND(B1<F1,B1<>"")
Select Format | Fill Tab
Set Fill color to red :)
Customized Way
Manually select cells B2 to last row in col B
Select Home Tab | Conditional formatting | New Rule | Use a formula to determine which cells to format
Enter the formula =AND(B2<F2,B2<>"")
Select Format | Fill Tab
Set Fill color to red :)
VBA Way
If you still want VBA then try this
Sub Sample()
Dim ws As Worksheet
Dim lRow As Long
'~~> Change as applicable
Set ws = Sheet1
With ws
lRow = .Range("B" & .Rows.Count).End(xlUp).Row
With .Range("B2:B" & lRow)
.FormatConditions.Add Type:=xlExpression, Formula1:="=AND(B2<F2,B2<>"""")"
.FormatConditions(.FormatConditions.Count).SetFirstPriority
With .FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.Color = 255
.TintAndShade = 0
End With
.FormatConditions(1).StopIfTrue = False
End With
End With
End Sub
Go to conditional formatting --> New Rule --> Use a formula to determine which cells to format --> Paste This: =IF(AND(B2<F2,B2<>"") = TRUE,1,0)
For the F column: =IF(AND(F2>B2,F2<>"") = TRUE,1,0)
If you want a VBA solution, try it without conditional formatting:
Sub StackOverflow()
Dim x As Long
With ThisWorkbook.Sheets("Stack")
For x = 1 To .Cells.Find("*", SearchOrder:=xlByRows, LookIn:=xlValues, SearchDirection:=xlPrevious).Row
If .Cells(x, 2).Value <> "" And .Cells(x, 2).Value < .Cells(x, 6).Value Then
.Cells(x, 2).Interior.Color = vbRed
.Cells(x, 6).Interior.Color = vbRed
.Cells(x, 2).Font.Color = vbWhite
.Cells(x, 6).Font.Color = vbWhite
Else
.Cells(x, 2).Interior.Pattern = xlNone
.Cells(x, 6).Interior.Pattern = xlNone
.Cells(x, 2).Font.Color = vbBlack
.Cells(x, 6).Font.Color = vbBlack
End If
Next x
End With
End Sub
Adapt the code to your needs (change the macro name, spreadsheet address and colors if you want).
enter image description hereI have today's data in column D which I want to compare with yesterday's data in column F, row wise.
Below is the code I'm using to compare and highlight duplicates.
A) Highlighting blank cells which I don't want.
B) I want to handle some exceptions like I don't wish to highlight $0.00 or specific text "No Data"
Sub CompareAndHighlight()
Dim Myrng1 As Range, Myrng2 As Range, i As Long, j As Long
Application.ScreenUpdating = False
For i = 3 To Sheets("Sheet1").Range("D" & Rows.Count).End(xlUp).Row
Set Myrng1 = Sheets("Sheet1").Range("D" & i)
For j = 3 To Sheets("Sheet1").Range("F" & Rows.Count).End(xlUp).Row
Set Myrng2 = Sheets("Sheet1").Range("F" & j)
If StrComp(Trim(Myrng1.Text), Trim(Myrng2.Text), vbTextCompare) = 0 Then
'If Myrng1.Value = Myrng2.Value Then
Myrng1.Interior.Color = RGB(255, 255, 0)
End If
Set Myrng2 = Nothing
Next j
Set Myrng1 = Nothing
Next i
Application.ScreenUpdating = True
End Sub
Data giving random errors on running macros multiple times after clearing highlighted colors.
Use the conditional formatting function.
Columns("A:A").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
Then after this create one loop that goes through your range and turns the colour of the cell to no colour where your conditions are met, alternatively you could just filter the data to exclude your cases, such as "No Data", and copy and paste the results into a new column. In fact you do not really need vba for this.
sticking with VBA you could try the following code:
Option Explicit
Sub CompareAndHighlight()
Dim refRng As Range, cell As Range
Application.ScreenUpdating = False
With Worksheets("Sheet1")
Set refRng = .Range("F3", .Cells(.Rows.Count, "F").End(xlUp)).SpecialCells(XlCellType.xlCellTypeConstants)
For Each cell In .Range("D3", .Cells(.Rows.Count, "D").End(xlUp)).SpecialCells(XlCellType.xlCellTypeConstants)
If cell.value <> 0 And cell.value <> "No Data" Then
If refRng.Find(what:=cell.value, LookIn:=xlFormulas, lookat:=xlWhole, MatchCase:=False) Is Nothing Then cell.Interior.color = RGB(255, 255, 0)
End If
Next cell
End With
Application.ScreenUpdating = True
End Sub
I need to identify, (by highlighting), when there is data missing from a certain column. In other words, I have a column of data specifying a country. Above this column there are blanks and below this column there are blanks. The topmost row of the data stays the same (the data always starts at row 4), but the bottom is variable. Also, due to the way this data is output, there seems to be 3 or so rows of blank but formatted cells at the bottom of the table which excel recognizes as 'used'. Here is my code thus far:
With ThisWorkbook.ActiveSheet
LastRowCountry = .Range("H" & .Rows.Count).End(xlUp).Row
End With
The Piece of code that is specific to my goal is:
'Search for blank Geo tags
With ThisWorkbook.ActiveSheet
If IsEmpty(Cells(LastRowCountry, "H")) = True Then
'Highlight Columns
With Range(Cells(4, "H"), Cells(LastRow, "H")).Interior
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent2
.TintAndShade = 0.799981688894314
.PatternTintAndShade = 0
End With
End If
End With
In this form it fails to recognize any blanks in the column and never highlights. Before this I preceded the code with:
With ActiveSheet.Cells.SpecialCells(xlLastCell)
LastRow = .Row
LastCol = .Column
End With
which always highlighted the column (I assume because it was detecting the blank but formatted cells hanging off the bottom of the table. Thanks in advance to anyone who takes this on.
Steve
I have tried this here and it works
Sub CheckForEmptyCells(Byref sh as Worksheet, ByRef col as string)
Dim lastR&
lastR = sh.Range(col & Rows.Count).End(xlUp).Row
Dim r As Range: Set r = Range(col & "5:" & col & lastR)
If Not r.Find("") Is Nothing Then
With r.Interior
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent2
.TintAndShade = 0.799981688894314
.PatternTintAndShade = 0
End With
End If
End Sub
Note: this routine checks only if the given column has empty cells in between its own first and last cells. If the goal is to check the whole column (last cell of the column might itself be empty), then you should use instead: lastR = sh.UsedRange.Rows.Count