Copy (visible) values in column after auto filter using VBA for Excel

[dahveedoff]

Ive got a vba script i am writing that I need help with.

So I am the stage where after auto filtering the dataset in Excel, I need to copy values down a column from a particular position. So what I have done is to identify the column header I need to copy values from, offset down two cells and then copy down to the last visible cell in that column.

I am using the resize() function to try to achieve that but it doesn't seem to be working. Can someone please help look at my code to identify where I'm going wrong?

Set ColHeader = Range("A1:XFD1").Find(arr1(k))ColHeader.Activate
ColHeader.Offset(2, 0).Select
ActiveCell.Resize(b).SpecialCells(xlCellTypeVisible).Select
Selection.Copy
ColHeader.Offset(1, 1).PasteSpecial Transpose:=True

"b" in the resize function is basically a calculation of how many visible rows are left in the column after autofiltering.

The last bit at the end is needed because I want to then transpose the values I have copied, across three columns next to the column header.

Thanks

 

[Zack Barresse]

The Resize method doesn't take into account the SpecialCells object, so your resize will be actual rows, not truncated by the SpecialCells object method(s). Instead, just use the entire range and qualify that by the SpecialCells(xlcelltypevisible) method.

 

[dahveedoff]

Thanks Zack. So when you say use the entire range you are talking about the UsedRange() function right?

I've kinda got a workaround now by using a couple of inner loops and assigning the some offset values to a range object dynamically and then just equating that to the value of another cell reference.

Thanks

David

 

[Zack Barresse]

You can use the UsedRange object but I tend to stay away from it. While there are other methods, perhaps you can use something like this:

    Dim ColHeader As Range
    
    On Error Resume Next
    Set ColHeader = Range("A1:XFD1").Find(arr1(k))
    On Error GoTo 0
    
    If Not ColHeader Is Nothing Then
        With ColHeader.Offset(2, 0).Resize(ActiveSheet.UsedRange.Rows.Count - 2, 1)
            .SpecialCells(xlCellTypeVisible).Copy
            .Offset(-1, 1).PasteSpecial Transpose:=True
        End With
    End If

 

[dahveedoff]

Thanks Zack!