I wrote an Excel VBA macro to do conditional formatting using an intersect of two columns but I can't get it to work for some reason. If anyone has any idea on what I can do to fix it, I would sincerely appreciate it.
I want to highlight both the source and the target columns in which there is a match or duplicate as follows:
E Column (Target)
0.0000%
0.0000%
11.1803%
12.7775%
13.7190%
13.9841%
13.9841%
14.5698%
14.9071%
15.5746%
15.6492%
16.1355%
16.1355%
16.3123%
16.3123%
19.0693%
19.4511%
21.9089%
21.9089%
21.9089%
V Column (Source)
13.7190%
14.9240%
15.4919%
20.4521%
21.5725%
23.3319%
23.7718%
24.1871%
25.7257%
27.2166%
28.2290%
29.7543%
29.7543%
30.4968%
31.0080%
31.9022%
32.8570%
33.3333%
33.3333%
34.7434%
34.9603%
34.9927%
36.4516%
36.8697%
37.5637%
38.2046%
38.6151%
38.7298%
38.7298%
39.3830%
40.2694%
41.8330%
42.2049%
Sub Highlight_rsd_5batch()
Dim WatchRange As Range, Target As Range, cell As Range
Set Target = Range("E19:E237") 'change column ref as required
Set WatchRange = Range("V19:V237")
For Each cell In Target.Cells
If Intersect(Target, WatchRange) Is Nothing Then
cell.Interior.ColorIndex = xlNone
Else: cell.EntireRow.Interior.ColorIndex = 6
End If
Next cell
End Sub
The Intersect function checks to see if the two ranges have any cells in common, not if they have values in common. You could use the CountIf function instead:
Sub Highlight_rsd_5batch()
Dim WatchRange As Range, Target As Range, cell As Range
Set Target = Range("E19:E237") 'change column ref as required
Set WatchRange = Range("V19:V237")
For Each cell In Target.Cells
If Application.WorksheetFunction.CountIf(WatchRange,cell.Value) > 0 Then
cell.Interior.ColorIndex = 6
For Each watchCell in WatchRange.Cells
If watchCell.value = cell.Value Then: watchCell.Interior.ColorIndex = 6
Next watchCell
Else: cell.EntireRow.Interior.ColorIndex = xlNone
End If
Next cell
End Sub
This task does not really require the use of VBA and could be accomplished using the same formulas in the Conditional Formatting tools under Format>Conditional Formatting. See the linked tutorial for more help.
Related
to organize my projects, I created an excel sheet, which is basically a calendar, but the dates are not fixed and differ from project to project. Certain dates should be colored in different ways. Thus far I used conditional formatting to achieve this, but I find CF to not always work as I want it to. Besides, since I do a lot of copy & pasting, the CF rules add up enourmously over time, slowing down the worksheet. VBA might also be more flexible in the end.
I started with coloring the cell containing today's date, using the following code (I am a VBA/Coding beginner; the code is from another website, I just modified it to suit my demands).
Option Explicit
Sub Worksheet_Change(ByVal Target As Range)
Dim cell As Range
Dim Dates As Range
Set Dates = Range("B2:H2," & _
"B6:H6")
For Each cell In Dates
If Not IsDate(cell.Value) Then
End If
If IsEmpty(cell.Value) Then
End If
If cell.Value = Date Then
cell.Interior.ColorIndex = 3
'Include more conditions e.g. lookup date in list of holidays; if date = holiday then different color
ElseIf cell.Value - Date <> 0 Then
cell.Interior.ColorIndex = 0
End If
Next cell
End Sub
Now I'd also like the macro to compare the dates in the range.1 "Dates" with a list of other dates (range.2) (e.g. holidays). If a cell from "Dates" matches with a cell from range.2, the cell that matches is supposed to get another color.
This was no problem with CF but here I am really at a loss.
I tried to do it manually by adding
ElseIf cell.Value = cell(1, 1).Value Then
cell.Interior.ColorIndex = 2
However, this colors all cells, not only the cell that matches with the date in cell(1, 1).
Any help is greatly appreciated.
Kind regards
Dennis
This is an example; the code checks values in ColA to values in ColB, and if a match is found, colors the cell in ColA, Change the references as desired.
Dim xcel As Range
Dim ycel As Range
With Worksheets("Sheet1")
For Each xcel In .Range("A1", .Cells(.Rows.Count, "A").End(xlUp))
For Each ycel In .Range("B1", .Cells(.Rows.Count, "B").End(xlUp))
If xcel.Value = ycel.Value Then
xcel.Interior.Color = RGB(255, 255, 0)
End If
Next ycel
Next xcel
End With
If you define range1 and range2 appropriately, the following will do the trick:
Sub colorCells()
Set range1 = Range("B1:B5")
Set range2 = Range("F1:F15")
For Each cel In range2
Set found = range1.Find(cel.Value, LookIn:=xlValues)
If found Is Nothing Then
cel.Interior.ColorIndex = 0
Else
cel.Interior.ColorIndex = 3
End If
Next cel
End Sub
All,
I have written the below code to check if cells in the variable range have conditional formatting. However the code falls over at "If Cells.ColorIndex = 3 Then" can anyone suggest why the error is occurring and if there is a better solution than the below code to achieve a loop through cols & rows (variable length)
Sub Check_Conditional()
Dim rng As Range
Dim row As Range
Dim cell As Range
Dim RW As Long
RW = ActiveSheet.Range("Total").Offset(rowOffset:=-1).row
Set rng = Range("O7:AB" & RW)
For Each row In rng.Rows
For Each cell In row.Cells
If Cells.ColorIndex = 3 Then
MsgBox "Not all the cells have been filled out"
Exit For
End If
Next cell
Next row
End Sub
cell.ColorIndex is not a valid Range property.
If you mean to check the font's color then use If cell.Font.ColorIndex = 3 Then
If you mean to check the Fill color, then use If cell.Interior.ColorIndex = 3 Then
When you type in the editor, Cell. the VBA autocompletes it with the following options:
There's no cell.ColorIndex in the list:
I'm attempting to create a worksheet macro that will populate specific cells with default values in the same row when a value is entered in the first column of the row and also copy an entered value from the same row into other cells in that row. For example, when the user enters some value in 2A, cells 2C and 2D automatically populate with the numbers 10 and 20 respectively. Then, when the user enters a value in 2S, that same value is automatically copied back to cells 2I and 2J.
Thanks for the additional info Ralph. Based off of what I've found through researching similar questions on stackoverflow and general internet searches, I put together the following:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim A As Range, S As Range, InteA As Range, InteS As Range, r As Range
Set A = Range("A:A")
Set S = Range("S:S")
Set InteA = Intersect(A, Target)
Set InteS = Intersect(S, Target)
Application.EnableEvents = False
If Not InteA Is Nothing Then
For Each r In InteA
r.Offset(0, 2).Value = "10"
r.Offset(0, 3).Value = "20"
Next r
ElseIf Not InteS Is Nothing Then
For Each r In InteS
r.Offset(0, -9).Value = Target
r.Offset(0, -10).Value = Target
r.Offset(0, -11).Value = Target
Next r
End If
Letscontinue:
Application.EnableEvents = True
Exit Sub
Whoa:
MsgBox Err.Description
Resume Letscontinue
End Sub
To get a macro to run, an event of some kind has to occur. Its tempting to try to run a macro whenever ANY change is made to the worksheet, but imagine how often that's going to trigger? All the time. Then you have to worry if 10 & 20 will start flying into those cells when you don't want them to and write some conditional code to skip the process if you aren't typing in column A...
So here's a different option you might prefer. Enter formulas in columns C and D that will result in 10 & 20 if data exists in A.
=IF(A2<>"",10,"") or =IF(ISNUMBER(A2),10,0) ...whatever you like.
Then select your header row and data row, convert to an real "Excel table" on the Insert menu. (Insert...Table) This will extend your formulas to new rows as you type into column A.
Macro averted?
I've seen how to say "Is cell x in range y" but since I'm using VLookup I'm not sure how to reconcile the two.
Basically, the code below does a lookup on a table that contains tips and then displays them in a specified cell. It works great. What I would like to do is specify an entire range of cells in the lookup table, then if the user selects any cell within that range the tip is displayed. As it stands, if I have a large area of say 10 cells I have to create 10 duplicate entries in the lookup table (one for each cell).
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim cellTitle As Range
Set cellTitle = Range("J2")
Dim cellTip As Range
Set cellTip = Range("J3")
If Target.Address = "$J$3:$K$5" Or Target.Address = "$J$2:$K$2" Or Target.Address = "$K$1" Then
'leave existing content in case user wants to copy tip
Else
Range("K1").Value = Target.Address
Title = Application.VLookup(Target.Address, Sheets("Settings").Range("TipsDashboard"), 2, False)
If Not IsError(Title) Then
Tip = Application.VLookup(Target.Address, Sheets("Settings").Range("TipsDashboard"), 3, False)
cellTitle.Value = Title
cellTip.Value = Tip
Else
cellTitle.Value = "Tips & Instructions"
cellTip.Value = "Try selecting various fields to get dynamic tips or instructions in this space."
End If
End If
End Sub
Here is a sample of my lookup table:
You'll notice there are ranges here, but they are merged cells.
edited: made so that it's possible to associate different cells in active sheet to the same range value in "cell" column of" Settings" sheet
Option Explicit
Private Sub Worksheet_SelectionChange(ByVal target As Range)
Dim cellTitle As Range, cellTip As Range, found As Range
Set cellTitle = Range("J2")
Set cellTip = Range("J3")
If target.address = "$J$3:$K$5" Or target.address = "$J$2:$K$2" Or target.address = "$K$1" Then
'leave existing content in case user wants to copy tip
Else
Range("K1").Value = target.address
Set found = GetCell(target, Sheets("Settings").Range("TipsDashboard").Columns(1))
If Not found Is Nothing Then
cellTitle.Value = found.Offset(, 1)
cellTip.Value = found.Offset(, 2)
Else
cellTitle.Value = "Tips & Instructions"
cellTip.Value = "Try selecting various fields to get dynamic tips or instructions in this space."
End If
End If
End Sub
Function GetCell(target As Range, sourceRng As Range) As Range
Dim cell As Range, cell2 As Range
With target
For Each cell In sourceRng.SpecialCells(xlCellTypeConstants, xlTextValues)
Set cell2 = GetRangeFromAddress(.Parent, cell.Value)
If Not cell2 Is Nothing Then
If Not Intersect(.cells, cell2) Is Nothing Then
Set GetCell = cell
Exit Function
End If
End If
Next cell
End With
End Function
Function GetRangeFromAddress(sht As Worksheet, address As String) As Range
On Error Resume Next
Set GetRangeFromAddress = sht.Range(address)
On Error GoTo 0
End Function
I would like to color cells that have "#N/A" value in the currentsheet. In order to do this i use following macro:
Sub ColorCells()
Dim Data As Range
Dim cell As Range
Set currentsheet = ActiveWorkbook.Sheets("Comparison")
Set Data = currentsheet.Range("A2:AW1048576")
For Each cell In Data
If cell.Value = "#N/A" Then
cell.Interior.ColorIndex = 3
End If
Next
End Sub
But the line If cell.Value = "#N/A" Then gives an error: Type mismatch. Maybe someone can help to understand where is the error? Thanks
Non VBA Solution:
Use Conditional Formatting rule with formula: =ISNA(A1) (to highlight cells with all errors - not only #N/A, use =ISERROR(A1))
VBA Solution:
Your code loops through 50 mln cells. To reduce number of cells, I use .SpecialCells(xlCellTypeFormulas, 16) and .SpecialCells(xlCellTypeConstants, 16)to return only cells with errors (note, I'm using If cell.Text = "#N/A" Then)
Sub ColorCells()
Dim Data As Range, Data2 As Range, cell As Range
Dim currentsheet As Worksheet
Set currentsheet = ActiveWorkbook.Sheets("Comparison")
With currentsheet.Range("A2:AW" & Rows.Count)
.Interior.Color = xlNone
On Error Resume Next
'select only cells with errors
Set Data = .SpecialCells(xlCellTypeFormulas, 16)
Set Data2 = .SpecialCells(xlCellTypeConstants, 16)
On Error GoTo 0
End With
If Not Data2 Is Nothing Then
If Not Data Is Nothing Then
Set Data = Union(Data, Data2)
Else
Set Data = Data2
End If
End If
If Not Data Is Nothing Then
For Each cell In Data
If cell.Text = "#N/A" Then
cell.Interior.ColorIndex = 4
End If
Next
End If
End Sub
Note, to highlight cells witn any error (not only "#N/A"), replace following code
If Not Data Is Nothing Then
For Each cell In Data
If cell.Text = "#N/A" Then
cell.Interior.ColorIndex = 3
End If
Next
End If
with
If Not Data Is Nothing Then Data.Interior.ColorIndex = 3
UPD: (how to add CF rule through VBA)
Sub test()
With ActiveWorkbook.Sheets("Comparison").Range("A2:AW" & Rows.Count).FormatConditions
.Delete
.Add Type:=xlExpression, Formula1:="=ISNA(A1)"
.Item(1).Interior.ColorIndex = 3
End With
End Sub
Use conditional formatting instead of VBA to highlight errors.
Using a VBA loop like the one you posted will take a long time to process
the statement If cell.Value = "#N/A" Then will never work. If you insist on using VBA to highlight errors, try this instead.
Sub ColorCells()
Dim Data As Range
Dim cell As Range
Set currentsheet = ActiveWorkbook.Sheets("Comparison")
Set Data = currentsheet.Range("A2:AW1048576")
For Each cell In Data
If IsError(cell.Value) Then
cell.Interior.ColorIndex = 3
End If
Next
End Sub
Be prepared for a long wait, since the procedure loops through 51 million cells
There are more efficient ways to achieve what you want to do. Update your question if you have a change of mind.
Select all cells by left-top corner
Choose [Home] >> [Conditional Formatting] >> [New Rule]
Choose [Format only cells that contain]
In [Format only cells with:], choose "Errors"
Choose proper formats in [Format..] button
You need to use cell.Text = "#N/A" instead of cell.Value = "#N/A". The error in the cell is actually just text stored in the cell.