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
Related
I am trying to create a VBA macro to fill in cells that are empty in a range ("INV_Nums") without overwriting the cell if it contains data already. In order to accomplish this I am trying to use an if statement to check if the cell in question is blank...if it is not, then I want the loop to continue on to the next cell, however if it IS blank then I want to input the index(__,(match()) function into the cell.
I keep getting a "compile error: mismatch" on the True statement but I'm at a loss as to why my synatax would be wrong. Any help would be appreciated.
Here is my code:
Dim i As Integer
Dim Rng As Range
Dim ARwkb As Excel.Workbook
Dim ARwks As Excel.Worksheet
Dim Samwkb As Excel.Workbook
Dim Samwks As Excel.Worksheet
Set Samwkb = Excel.Workbooks("Samples - one sheet")
Set Samwks = Samwkb.Worksheets("samples shipment")
Set ARwkb = Excel.Workbooks("AR balance.xlsx")
Set ARwks = ARwkb.Worksheets("Total Trading")
Set Rng = Samwkb.Range("INV_Nums")
For i = 6 To Rng.Rows.Count + 6
If Range("AAi") = "" Is True Then
Range("AAi").Select
ActiveCell.FormulaR1C1 = _
"=INDEX('AR balance.xlsx'!AR_Invoice_Nums,MATCH(RC[-21],'AR
balance.xlsx'!AR_PL_Nums,0))"
End If
Next i
The problem is in how you are identifying the range and administering the criteria.
For i = 6 To Rng.Rows.Count + 6
If IsEmpty(Range("AA" & i)) Then
Range("AA" & i).FormulaR1C1 = _
"=INDEX('AR balance.xlsx'!AR_Invoice_Nums, MATCH(RC[-21],'AR balance.xlsx'!AR_PL_Nums, 0))"
End If
Next i
The .SpecialCells method can quickly determine the blank cells and an xlR1C1 formula can be used to insert all of the formulas at once..
...
with Samwkb.Range("INV_Nums")
.specialcells(xlcelltypeblanks).FormulaR1C1 = _
"=INDEX('AR balance.xlsx'!AR_Invoice_Nums, MATCH(RC[-21],'AR balance.xlsx'!AR_PL_Nums, 0))"
end with
...
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 have a routine, that fills a calendar with all important events for the commodity markets for each day of the following week. I have a calendar grid laid out on the page and have ten named cells for each day i.e. Monday1, Monday2 and so on (each day only goes up to 10 for now, i.e.Monday10), in each days column. BTW the cells are 2 cells wide and 2 cells deep. Many times there are more than 10 events for a given day. I am trying to test for the named range to see if it exists, if not copy the format of the last named range cell and name that cell the next name in the series.
I am only having two issues with the above, first and foremost is how to test to determine in a name for a named range already exists. I am currently iterating thru the entire list of ThisWorkbook.Names, which has thousands of named ranges in it. Since this iteration could be running over 100 times when the calendar is generating, it is wicked slow (as would be expected). Is there a better, faster way to check if a name already exists as a named range?
The second issue is how to copy the formatting of a 4 cell, merged cell, since the address always comes up as only the top left corner cell so offsetting the range doesn't work appropriately. I hacked around to get this code to at least come up with the right range for the next merged cell group in the column
Set cCell = Range("Thursday" & CStr(y))
'even tho cCell is a 4 cell merged cell, cCell.Address returns the address of top left cell
Set destRange = Range(cCell.Address & ":" & cCell.offset(2, 0).offset(0, 1).Address)
Recording a macro to drag the formatting down, shows this code.
Range("G22:H23").Select
Selection.AutoFill Destination:=Range("G22:H25"), Type:=xlFillFormats
Range("G22:H25").Select
Since Range("G22:H23") is the same as cCell, and Range("G22:H25") is the same as destRange. The following code should work, but doesn't.
Set cCell = Range("Thursday" & CStr(y))
Set destRange = Range(cCell.Address & ":" & cCell.offset(2, 0).offset(0, 1).Address)
cCell.AutoFill Destination:=destRange, Type:=xlFillFormats
Application.CutCopyMode = False
cCell.offset(1, 0).Name = rangeName
FYI, it doesn't work if I select cCell and use Selection.AutoFill either.
Any thoughts on how to copy that cell formatting down the column one cell at a time when needed?
Update:
This now works for copying the formatting down from one merged cell to another of same size. For some reason setting destRange to the whole range (the copy cell and pastecell entire range as the macro recorder showed) didnt work but setting destRange to the cell range that needed formatting, and then doing a union of cCell and destRange worked, and made naming the new range easier.
rangeName = "Friday" & CStr(y + 1)
priorRangeName = "Friday" & CStr(y)
namedRangeExist = CheckForNamedRange(rangeName)
If namedRangeExist = False Then
Set cCell = Range(priorRangeName)
Set destRange = Range(cCell.offset(1, 0).Address & ":" & cCell.offset(2, 0).offset(0, 1).Address)
cCell.AutoFill Destination:=Union(cCell, destRange), Type:=xlFillFormats
Application.CutCopyMode = False
destRange.Name = rangeName
End If
Update #2
There is an issue with naming ranges in a For loop ( the code below is running inside a For loop). The first time the new rangeName is not found, Setting cCell to the prior range name and running through the code to copy the merged cell format and name the new range works fine. Here is the code
rangeName = "Thursday" & CStr(y + 1)
priorRangeName = "Thursday" & CStr(y)
namedRangeExist = DoesNamedRangeExist(rangeName)
If namedRangeExist = False Then
Set cCell = Range(priorRangeName)
Debug.Print "cCell:" & cCell.Address
Set cCell = cCell.MergeArea
Debug.Print "Merged cCell:" & cCell.Address
Set destRange = Range(cCell.offset(1, 0).Address & ":" & cCell.offset(2, 0).offset(0, 1).Address)
Debug.Print "Dest:" & destRange.Address
Debug.Print "Unioned:" & Union(cCell, destRange).Address
cCell.AutoFill Destination:=Union(cCell, destRange), Type:=xlFillFormats
Application.CutCopyMode = False
destRange.name = rangename
End If
results in the following ranges
cCell:$G$22
Merged cCell:$G$22:$H$23
Dest:$G$24:$H$25
Unioned:$G$22:$H$25
but if more than one new named range needs to be created the second time thru this code produces a range area as evidenced by the output shown below
cCell:$G$24:$H$25
so why does cCell's address show as only the upper left cells address when run the first time, but the second time thru cCell's address is shown as the whole merged cell range? And because it does, the next code line produces a range object error
Set cCell = cCell.MergeArea
Eliminating that code line and amending the first Set cCell to this;
Set cCell = Range(priorRangeName).MergeArea
produces the same error. I could kludge this by setting a counter, and if more than one, bypass that code line but that is not the preferred solution.
First and foremost, create a function to call the named range. If calling the named range generate an error the function will return False otherwise it will return True.
Function NameExist(StringName As String) As Boolean
Dim errTest As String
On Error Resume Next
errTest = ThisWorkbook.Names(StringName).Value
NameExist = CBool(Err.Number = 0)
On Error GoTo 0
End Function
As for your second question, I had not problem with the autofill.
I would replce Set destRange = Range(cCell.Address & ":" & cCell.offset(2, 0).offset(0, 1).Address) with Set destRange = cCell.Resize(2,1). It has the same effect but the later is much cleaner.
Application.Evaluate and Worksheet.Evaluate can be used to get error value instead of error :
If Not IsError(Evaluate("Monday1")) Then ' if name Monday1 exists
The error can be ignored or jumped over (but that can result in hard to detect errors) :
On Error GoTo label1
' code that can result in error here
label1:
If Err.Number <> 0 Then Debug.Print Err.Description ' optional if you want to check the error
On Error GoTo 0 ' to reset the error handling
Range.MergeArea can be used to get the Range of merged cell.
I created a function to extend the name ranges and fill in the formatting. The first named range in the series will have to be setup. The Name itself needs to be set to the top left cell in the merged area.
ExtendFillNamedRanges will calculate the positions of the named ranges. If a cell in one of the positions isn't part of a MergedArea it will fill the formatting down from the last named range. It will name that cell. The scope of the names is Workbook.
Sub ExtendFillNamedRanges(BaseName As String, MaxCount As Integer)
Dim x As Integer, RowCount As Integer, ColumnCount As Integer
Dim LastNamedRange As Range, NamedRange As Range
Set NamedRange = Range(BaseName & 1)
RowCount = NamedRange.MergeArea.Rows.Count
ColumnCount = NamedRange.MergeArea.Columns.Count
For x = 2 To MaxCount
Set NamedRange = NamedRange.Offset(RowCount - 1)
If Not NamedRange.MergeCells Then
Set LastNamedRange = Range(BaseName & x - 1).MergeArea
LastNamedRange.AutoFill Destination:=LastNamedRange.Resize(RowCount * 2, ColumnCount), Type:=xlFillDefault
NamedRange.Name = BaseName & x
End If
'NamedRange.Value = NamedRange.Name.Name
Next
End Sub
Here is the test that I ran.
Sub Test()
Application.ScreenUpdating = False
Dim i As Integer, DayName As String
For i = 1 To 7
DayName = WeekDayName(i)
Range(DayName & 1).Value = DayName & 1
ExtendFillNamedRanges DayName, 10
Next i
Application.ScreenUpdating = True
End Sub
Before:
After:
I found this on ozgrid and made a little function out of it:
Option Explicit
Function DoesNamedRangeExist(VarS_Name As String) As Boolean
Dim NameRng As Name
For Each NameRng In ActiveWorkbook.Names
If NameRng.Name = VarS_Name Then
DoesNamedRangeExist = True
Exit Function
End If
Next NameRng
DoesNamedRangeExist = False
End Function
You can put this line in your code to check:
DoesNamedRangeExist("Monday1")
It will return a Boolean value (True / False) so it's easy to use with an IF() statement
As to your question on merged cells, I did a quick macro record on a 2*2 merged cell and it gave me this (made smaller and added comments):
Sub Macro1()
Range("D2:E3").Copy 'Orignal Merged Cell
Range("G2").PasteSpecial xlPasteAll 'Top left of destination
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.
I am using Excel 2010 and trying to add a bunch of rows placing the sum of columns A and B in column C. If the sum is over 500 I would then like to boldface the number in column C. My code below works works mathematically but will not do the bold formatting. Can someone tell me what I am doing wrong? Thank you.
Public Sub addMyRows()
Dim row As Integer 'creates a variable called 'row'
row = 2 'sets row to 2 b/c first row is a title
Do
Cells(row, 3).Formula = "=A" & row & "+B" & row 'the 3 stands for column C.
If ActiveCell.Value > 500 Then Selection.Font.Bold = True
row = row + 1
'loops until it encounters an empty row
Loop Until Len(Cells(row, 1)) = 0
End Sub
Pure VBA approach:
Public Sub AddMyRows()
Dim LRow As Long
Dim Rng As Range, Cell As Range
LRow = Range("A" & Rows.Count).End(xlUp).Row
Set Rng = Range("C2:C" & LRow)
Rng.Formula = "=A2+B2"
For Each Cell In Rng
Cell.Font.Bold = (Cell.Value > 500)
Next Cell
End Sub
Screenshot:
An alternative is conditional formatting.
Hope this helps.
Note: The formula in the block has been edited to reflect #simoco's comment regarding a re-run of the code. This makes the code safer for the times when you need to re-run it. :)