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:
Related
Have a sheet with a list of Cell references in two columns.
Trying to create a macro that pulls these into a range and uses the first cell in column A for the start point of an autoshape line and the second cell in column B as the end point of an autoshape line.
The script is working and doing what I want it to however at the end of execution I am getting "Subscript out of range error"
What am I doing wrong?
rng = Range("A1:B100")
Worksheets("Map").Activate
For Each row In rng
i = i + 1
ActiveSheet.Shapes.AddConnector(msoConnectorStraight, Range(rng(i, 1)).Left, Range(rng(i, 1)).Top, Range(rng(i, 2)).Left, Range(rng(i, 2)).Top).Select
Next row
Avoid select and activate, declare all the variables and loop only from the rows of the range:
Sub TestMe()
Dim rng As Range
Set rng = Worksheets("Map").Range("A1:B100")
Dim row As Range
Dim i As Long
For Each row In rng.Rows
i = i + 1
Worksheets("Map").Shapes.AddConnector msoConnectorStraight, _
row.Cells(i, 1).Left, _
row.Cells(i, 1).Top, _
row.Cells(i, 2).Left, _
row.Cells(i, 2).Top
Next row
End Sub
How to avoid using Select in Excel VBA
The Range("A1:B100") has no connection to Worksheets("Map") beyond a possible coincidence that Worksheets("Map") was the active worksheet. Provide proper parent worksheet reference.
You Set objects like ranges to their vars.
Don't Select the connectors you create; not in a loop, not ever.
with Worksheets("Map")
set rng = .Range("A1:B100")
For Each row In rng
i = i + 1
.Shapes.AddConnector msoConnectorStraight, _
.Range(rng(i, 1)).Left, .Range(rng(i, 1)).Top, _
.Range(rng(i, 2)).Left, .Range(rng(i, 2)).Top
Next row
end with
I am attempting to Loop through a Column K starting at row 14 until the end. I have written the following code, but it stops working at the Range("K14:") line. I tried using Range("K14"& Rows.Count) but that didn't help either.
Windows("Price VolatilityDM.xlsm").Activate
Sheets("Volatility Static Data").Activate
Dim x As Single
Dim Cell As Range
For Each Cell In Range("K14:")
If Cell.Value > 0.25 Then
Sheets("Volatility Static Data").Range("B:K").Copy
Windows("Tolerance ReportDM.xslm").Activate
Sheets("Sheet1").Range("K17:Q17").Paste
End If
Next Cell
Windows("Price VolatilityDM.xlsm").Activate
Sheets("Volatility Static Data").Activate
Set sh = ThisWorkbook.Workheets("Volatility Static Data") ' add a reference to the sheet for simplicity
Dim x As Single
Dim Cell As Range
Dim lastRow
lastRow = sh.Cells(sh.Rows.Count, "K").End(xlUp).Row ' get the last row
For Each Cell In Range("K14:K" & lastRow)
If Cell.Value > 0.25 Then
Sheets("Volatility Static Data").Range("B:K").Copy
Windows("Tolerance ReportDM.xslm").Activate
Sheets("Sheet1").Range("K17:Q17").Paste
End If
Next Cell
You just need to find the end of the Range object and make sure you iterate over to that. See above; if there are any questions, let me know.
It stops there because you haven't completed writing the whole range. "K14:" is invalid syntax. For example, you could do: "K14:K" & LastRow
you can use something like this to find the end of column K starting at 14:
dim end as range
set cell = range("K14")
'go down one cell at a time until you find that
'the next one is empty. This is the end of the column
do while not cell.offset(1,0).value = ""
set cell = cell.offset(1,0)
loop
set end = cell
and then use for each cell in range("K14:" & end.address)
In your code it'd look like this:
Windows("Price VolatilityDM.xlsm").Activate
Sheets("Volatility Static Data").Activate
Dim x As Single
Dim Cell As Range
dim end as range
set cell = range("K14")
'go down one cell at a time until you find that
'the next one is empty. This is the end of the column
do while not cell.offset(1,0).value = ""
set cell = cell.offset(1,0)
loop
set end = cell
For Each Cell In Range("K14:" & end.address)
If Cell.Value > 0.25 Then
Sheets("Volatility Static Data").Range("B:K").Copy
Windows("Tolerance ReportDM.xslm").Activate
Sheets("Sheet1").Range("K17:Q17").Paste
End If
Next Cell
I cant seem to find a solution for my application after endless searching. This is what I want to do:
I have cells in one excel sheet that can contain a mixture of dates and empty cells in one column. I want to then select the cells that have only dates and then copy them to a corresponding column in another sheet. They must be pasted in exactly the same order as in the first sheet because there are titles attached to each row. I do get it right with this code:
'Dim i As Long
'For i = 5 To 25
'If Not IsEmpty(Sheets("RMDA").Range("D" & i)) Then _
Sheets("Overview").Range("D" & i) = Sheets("RMDA").Range("D" & i)
'Next i
However, the dates in the first sheet are being updated on a daily basis and it can be that one title has not been updated (on another day) on the first sheet because the user has not checked it yet. If I leave it blank and If I follow the same procedure then it will "overwrite" the date in the second sheet and make the cell blank, which I do not want. I hope I was clear. Can someone please help me?
Regards
You can accomplish this very easily (and with little code) utilizing Excel's built-in AutoFilter and SpecialCells methods.
With Sheets("RMDA").Range("D4:D25")
.AutoFilter 1, "<>"
Dim cel as Range
For Each cel In .SpecialCells(xlCellTypeVisible)
Sheets("Overview").Range("D" & cel.Row).Value = cel.Value
Next
.AutoFilter
End With
you could try something like. This will give you the non blanks from the range, there may be an easier way... hope it helps
Sub x()
Dim rStart As Excel.Range
Dim rBlanks As Excel.Range
Set rStart = ActiveSheet.Range("d1:d30")
Set rBlanks = rStart.SpecialCells(xlCellTypeBlanks)
Dim rFind As Excel.Range
Dim i As Integer
Dim rNonBlanks As Excel.Range
For i = 1 To rStart.Cells.Count
Set rFind = Intersect(rStart.Cells(i), rBlanks)
If Not rFind Is Nothing Then
If rNonBlanks Is Nothing Then
Set rNonBlanks = rFind
Else
Set rNonBlanks = Union(rNonBlanks, rFind)
End If
End If
Next i
End Sub
Just because a cell is blank does not mean that it is actually empty.
Based on your description of the problem I would guess that the cells are not actually empty and that is why blank cells are being copied into the second sheet.
Rather than using the "IsEmpty" function I would count the length of the cell and only copy those which have a length greater than zero
Dim i As Long
For i = 5 To 25
If Len(Trim((Sheets("RMDA").Range("A" & i)))) > 0 Then _
Sheets("Overview").Range("D" & i) = Sheets("RMDA").Range("D" & i)
Next i
Trim removes all spaces from the cell and then Len counts the length of the string in the cell. If this value is greater than zero it is not a blank cell and therefore should be copied.
I'm writing a macro in Excel 2010 in order to remove line breaks in multiple cells of a column. This cells need to be selected by the user. Following this previous post I was able to create an InputBox to let the user select the range but now, I am unable to process the data within the selection.
My previous code without the selection range parsed an entire column with a regexp to find a pattern in the string within the cells and change its contents.
I did this with a For i To Rows.Count block of code like this:
For i = 1 To Rows.Count
If Not IsEmpty(Cells(i, 5).Value) Then
varString = Sheets(ActiveSheet.Name).Cells(i, 5).Text
Sheets(ActiveSheet.Name).Cells(i,5).Value=objRegExp.Replace(varString, "$1 ")
End If
Next i
Now I want to replace the static column so I can process only the user range.
In order to achieve that I tried this:
Set selection = Application.InputBox(Prompt:= _
"Please select a range to apply the remove break lines procedure.", _
Title:="Remove Line Breaks", Type:=8)
If selection Is Nothing Then
Exit Sub
End If
Set RowsNumber = selection.CurrentRegion -> This line gives me an error: "Object required"
Set RowsNumber = RowsNumber.Rows.Count
For i = 1 To RowsNumber
If Not IsEmpty(Cells(i, 5).Value) Then
varString = Sheets(ActiveSheet.Name).Cells(i, 5).Text
Sheets(ActiveSheet.Name).Cells(i, 5).Value = objRegExp.Replace(varString, "$1 ") 'Replace pattern found with regular expression in the same line
End If
Next i
How can I access the cells in the range returned by the InputBox?
I also tried changing RowsNumber with selection.Rows.Count but that way, although it doesn't gives an error, the cells used have blank string within them when I run the debugger. I think this is because I try to access row = 5 when the range could be less, i.e 3 if user just selects 3 cells.
I tried a For Each Next loop but then again, I know not how to access the cells withing the selection range.
You can iterate through the cells of a range by using For Each loop.
Below is your code modified. I have changed the name of variable Selection to rng, because Selection is Excel library built-in function and this name should be avoided.
Sub x()
Dim rng As Excel.Range
Dim cell As Excel.Range
Set rng = Application.InputBox(Prompt:= _
"Please select a range to apply the remove break lines procedure.", _
Title:="Remove Line Breaks", Type:=8)
If rng Is Nothing Then
Exit Sub
End If
For Each cell In rng.Cells
If Not IsEmpty(cell.Value) Then
varString = cell.Text
cell.Value = objRegExp.Replace(varString, "$1 ") 'Replace pattern found with regular expression in the same line
End If
Next cell
End Sub
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.