CODEWITHSUNDEEP
excelvbaautofilter
Handreen
Handreen

Reputation: 77

How to Autofilter then Copy and Paste Visible Cells only

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:

enter image description here

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:

enter image description here

Upvotes: 1

Views: 1376

Answers (2)

Sumit Chauhan
Sumit Chauhan

Reputation: 11

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[1]"
Intersect(.Range("AM:AM"), .UsedRange).Copy
.Range("AM1").PasteSpecial (xlPasteValues)
Application.CutCopyMode = False
End If
End With

End Sub
[/VBA]

Upvotes: 0

BigBen
BigBen

Reputation: 50008

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

Some notes:

  • The On Error Resume Next and On Error GoTo 0 are needed since a SpecialCells(xlCellTypeBlanks) call will fail if there are no blanks. They temporarily disable and then re-enable error handling.
  • Areas are each distinct area of a non-contiguous range. For example, if blankCells refers to AM2 and AM4:AM5, then AM2 is the first area and AM4:AM5 is the second.
  • You need to loop through the areas because trying to value transfer .Value = .Value doesn't work correctly when there is more than one area.

Upvotes: 2

Related Questions