I am trying to basically fill in any blank cells in column “AM” with values from column “AN” in a worksheet called “Operator” by assigning a shape to a macro with the following code. Please NOTE that the cells in An have an equation in them ,so I only want to copy the values.
Sub PendingChanges() Range("AM1:AM10").CurrentRegion.AutoFilter Field:=1, Criteria1:="=" Worksheets("Operator").Range("AM1:AM10").SpecialCells(xlCellTypeVisible).Value = Worksheets("Operator").Range("AN1:AN10").Value Selection.AutoFilter Field:=1 End Sub
I know that there is a “SpecialCells” method that displays visible cells only (so after autofiltering, it would display the blanks for me) but I’m not sure how to include it into my code!
The following screenshot is how the sheet will initially look: (in this example the cell values of AN3 and AN5 will paste into AM3 and AM5 respectively:
My code autofilters column “AN” for any blank cells, then tries to copy cells in AN and pastes the visible cells values into cells in AM
The result should be the following:
No need to filter here; you can just use
SpecialCells(xlCellTypeBlanks), and then
Offset on the result to refer to the same rows, but in column “AN”.
Sub PendingChanges() On Error Resume Next Dim blankCells as Range Set blankCells = Worksheets("Operator").Range("AM1:AM10").SpecialCells(xlCellTypeBlanks) On Error GoTo 0 If Not blankCells Is Nothing Then Dim rng as Range For Each rng in blankCells.Areas rng.Value = rng.Offset(,1).Value Next End If End Sub
On Error Resume Nextand
On Error GoTo 0are needed since a
SpecialCells(xlCellTypeBlanks)call will fail if there are no blanks. They temporarily disable and then re-enable error handling.
Areasare each distinct area of a non-contiguous range. For example, if
AM2is the first area and
AM4:AM5is the second.
- You need to loop through the areas because trying to value transfer
.Value = .Valuedoesn’t work correctly when there is more than one area.
You don’t need to make the filters and then fill the blanks from next column
You may try the below code, it may directly solve your problem.
[VBA] Sub test() Dim rBlanks As Range Set rBlanks = Nothing With ThisWorkbook.Sheets("Operator") On Error Resume Next Set rBlanks = Intersect(.Range("AM:AM"), .UsedRange).SpecialCells(xlCellTypeBlanks) On Error GoTo 0 If Not rBlanks Is Nothing Then rBlanks.FormulaR1C1 = "=RC" Intersect(.Range("AM:AM"), .UsedRange).Copy .Range("AM1").PasteSpecial (xlPasteValues) Application.CutCopyMode = False End If End With End Sub [/VBA]