[Article & AddIn] How to paste into a filtered range

[Andreas Killer]

The most urgent question for the target area is how we determine the visible cells, since we assume that the data can be filtered in any way.

Luckily, Excel has the SpecialCells function and most programmers call it directly. However, this feature comes with a few issues and may not work as expected. This is the case, for example, if we only check a single cell.

Sub Example_SpecialCells_DontWork()
  'Create the scenario
  ScenarioA
  'Clear some cells
  Range("B2:C2,D1:D2,5:10").Clear
  'B2 is empty, so this cell should be selected only!
  Range("B2").SpecialCells(xlCellTypeBlanks).Select
End Sub

To be 100% sure, we need to encapsulate the function in another function and catch this error. If you found this article by chance, the SpecialCells function is included in the files in the modLowLevel module, the download link is at the top of the article.

Sub Example_SpecialCells_Works()
  'Create the scenario
  ScenarioA
  'Clear some cells
  Range("B2:C2,D1:D2,5:10").Clear
  'B2 is empty, so this cell should be selected only!
  SpecialCells(Range("B2"), xlCellTypeBlanks).Select
End Sub

And with that we can also deal with another problem, it is possible that no cells are visible at all and in this case our function returns Nothing.

Sub Example_SpecialCells_RTE()
  Dim Dest As Range
  'Create the scenario
  ScenarioA
  'Select some cells
  Range("B3:E5").Select
  'Filter the cells
  Range("A1").AutoFilter
  Range("A1").AutoFilter 1, "A8"
  'In case of all seleczed cells are filtered out, no cells are visible!
  'This is the save way to detect this
  Set Dest = SpecialCells(Selection, xlCellTypeVisible)
  If Dest Is Nothing Then
    MsgBox "No visible cells"
  End If
  'This line results in an RTE 1004
  Set Dest = Selection.SpecialCells(xlCellTypeVisible)
End Sub

With this we have almost all the tools together, only one thing is missing and to understand why we need it we have to look at a new scenario.

[Andreas Killer]

Here is the code for the new scenario.

Sub ScenarioB()
  Dim Dest As Range
  'Remove the AutoFilter if any
  If ActiveSheet.AutoFilterMode Then Cells.AutoFilter
  'Clear all cells
  Cells.Clear
  'Refer to some cells
  Set Dest = Range("B2:F12")
  With Dest.Offset(1)
    'Write a formula into to get the address of the cell
    .Formula = "=ADDRESS(ROW(),COLUMN(),4)"
    'Write 1 or 0 into the fist column
    .Columns(1).Formula = "=MOD(ROW(),2)"
    'Convert the formulas to values (using a 2D-array "on the fly")
    .Value = .Value
  End With
  'Add Headers
  With Dest.Rows(1)
    .Formula = "=LEFT(ADDRESS(ROW(),COLUMN(P1),4),1)"
    .Value = .Value
  End With
  'Add an AutoFilter
  Dest.AutoFilter
  'Filter the first column
  Dest.AutoFilter 1, 1
  'Select some cells in there
  Dest.Offset(2, 2).Resize(6, 2).Select
End Sub

And here is how it looks like:

[Andreas Killer]

We have a filtered area and in this area a range is selected. Let's take a look at what happens when we just write an array in there.

Sub MultipleDestinationCells_DontWork()
  Dim Dest As Range
  Dim r As Long, c As Long
  Dim Data
  'Create the scenario
  ScenarioB
  
  'Get the visible selected cells
  Set Dest = SpecialCells(Selection, xlCellTypeVisible)
  'Do we have any?
  If Dest Is Nothing Then
    MsgBox "No visible cells selected"
    Exit Sub
  End If
  'Get the number of rows and columns
  RangeCount Dest, r, MaxColumns:=c
  'Create an array of that size and fill it:
  '11 12
  '21 22
  '31 32
  ReDim Data(1 To r, 1 To c)
  For c = 1 To UBound(Data, 2)
    For r = 1 To UBound(Data)
      Data(r, c) = r * 10 + c
    Next
  Next
  'Write it into
  Dest.Value = Data
End Sub

Surprisingly, we don't get an error message and the filtered cells are not overwritten, but the values in the cells are completely wrong.



It would still be understandable that we always get an 11 in the first column and always a 12 in the second. However, why a 31 appears in E7 is incomprehensible even to me. It obviously doesn't work that way at all.
We need to traverse the visible area, but not cell by cell. Multiple ranges in a Range object are automatically divided into Areas, and we can write a suitable array into each Area. So, we need a routine that copies the appropriate portion from our data array. Then we just need to execute a counter to get the next portion for the next range.

Sub MultipleDestinationCells_Works()
  Dim Dest As Range, Area As Range
  Dim r As Long, c As Long
  Dim Data, Part
  'Create the scenario
  ScenarioB
  
  'Get the visible selected cells
  Set Dest = SpecialCells(Selection, xlCellTypeVisible)
  'Do we have any?
  If Dest Is Nothing Then
    MsgBox "No visible cells selected"
    Exit Sub
  End If
  'Get the number of rows and columns
  RangeCount Dest, r, MaxColumns:=c
  'Create an array of that size
  ReDim Data(1 To r, 1 To c)
  For c = 1 To UBound(Data, 2)
    For r = 1 To UBound(Data)
      Data(r, c) = r * 10 + c
    Next
  Next
  'We start at row 1 always!
  r = 1
  For Each Area In Dest.Areas
    'Copy the part of the Data array that fit's into the Area
    CopyPart Data, Part, r, 1, Area.Rows.Count, Area.Columns.Count
    'Write into
    Area.Value = Part
    'Increment the row counter
    r = r + Area.Rows.Count
  Next
End Sub

And that's it.



Finally, there is just one more detail to note: If you copy data from an HTML source, you may get several arrays. In order to keep the arrays as small as possible, these arrays are not combined into one, but processed individually one after the other. If you have any questions about the tool or the explanations, please post them here. I'll do my best to explain them to you.

Best regards, Andreas.