1004 error .advancedfilter

[Youngdand]

Hi,

I have a sheet, with a dataset which is 18 columns, however, further datasets of 18 columns are repeated throughout the sheet horizontally. I need to stack this data vertically. below is a crude example of the table i have and what i need to do is take all the data outside of columns a and b, and to add them to bottom of column a and b ideally without any spaces.


[TABLE="class: grid, width: 500, align: left"]
<tbody>[TR]
[TD]A[/TD]
[TD]B[/TD]
[TD]C[/TD]
[TD]D[/TD]
[TD]E[/TD]
[TD]F[/TD]
[TD]G[/TD]
[TD]H[/TD]
[TD]I[/TD]
[TD]J[/TD]
[/TR]
[TR]
[TD]Set 1[/TD]
[TD]Set1[/TD]
[TD]Set 2[/TD]
[TD]Set 2[/TD]
[TD]Set 3[/TD]
[TD]Set 3[/TD]
[TD]Set 4[/TD]
[TD]Set 4[/TD]
[TD]Set 5[/TD]
[TD]Set 5[/TD]
[/TR]
[TR]
[TD]acb[/TD]
[TD]acb[/TD]
[TD]abc1[/TD]
[TD]abc1[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]bcd[/TD]
[TD]bcd[/TD]
[TD]bcd1[/TD]
[TD]bcd1[/TD]
[TD]bcd2[/TD]
[TD]bcd2[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]cde[/TD]
[TD]cde[/TD]
[TD]cde1[/TD]
[TD]cde1[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]def[/TD]
[TD]def[/TD]
[TD]def1[/TD]
[TD]def1[/TD]
[TD]def2[/TD]
[TD]def2[/TD]
[TD]def3[/TD]
[TD]def3[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]efg[/TD]
[TD]efg[/TD]
[TD]efg1[/TD]
[TD]efg1[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]fgh[/TD]
[TD]fgh[/TD]
[TD]fgh1[/TD]
[TD]fgh1[/TD]
[TD]fgh2[/TD]
[TD]fgh2[/TD]
[TD]fgh3[/TD]
[TD]fgh3[/TD]
[TD]fgh4[/TD]
[TD]fgh4[/TD]
[/TR]
[TR]
[TD]ghi[/TD]
[TD]ghi[/TD]
[TD]ghi1[/TD]
[TD]ghi1[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]ghi[/TD]
[TD]ghi[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]


















I have been trying to write a macro which achieves this however, i am getting a 1004 error in relation to an advanced filter i am trying to perform.

Sub Stackrepeats()
Dim lr As Long
Dim lastcol As Long
Dim cr As Range
Dim TS As Worksheet
Dim NLR As Long
Set TS = ActiveSheet

Do Until lastcol = 18
With TS.UsedRange
lr = Cells(Rows.Count, 1).End(xlUp).Row
lastcol = .Columns(.Columns.Count).Column
Set cr = .Range(.Cells(1, 19), .Cells(lr, lastcol))
cr.AdvancedFilter Action:=xlFilterCopy, criteriarange:=TS.Range(.Cells(1, 1)), copytorange:=TS.Range(.Cells(lr + 1, 1)), Unique:=True
cr.ClearContents
Application.CutCopyMode = False
End With
Loop
End Sub

it fails on line:

cr.AdvancedFilter Action:=xlFilterCopy, criteriarange:=TS.Range(.Cells(1, 1)), copytorange:=TS.Range(.Cells(lr + 1, 1)), Unique:=True

Can anyone help on this? is there a better way of achieving what i am after?

Cheers,

Dan.

 

[Dryver14]

Are you missing a criteria?

 

[Youngdand]

HI,

Not that i am aware of, as i thought using this method, i would get only unique values based on the rangecriteria specified.

But that just be my twisted logic!.

 

[Youngdand]

So it took a while with my basic knowledge of VBA but eventually i came up with the solution below, if anyone is interested:

Sub Stackrepeats()
Dim lr As Long
Dim lastcol As Long
Dim cr As Range
Dim TS As Worksheet
Dim NLR As Long
Set TS = ActiveSheet
TS.Range("a1").EntireRow.Insert
Application.ScreenUpdating = False
With TS.UsedRange
lr = TS.Cells(Rows.Count, 1).End(xlUp).Row
lastcol = .Columns(.Columns.Count).Column
Debug.Print (lastcol)
End With
For i = 18 To lastcol
If lastcol = 18 Then GoTo Finish
lr = TS.Cells(Rows.Count, 1).End(xlUp).Row
Set cr = TS.Range(Cells(1, 19), Cells(lr, lastcol))
If TS.AutoFilterMode = True Then TS.AutoFilterMode = False
With cr
.AutoFilter field:=1, Criteria1:="<>"
.SpecialCells(xlCellTypeVisible).Copy
End With
TS.AutoFilterMode = False
With TS
.Cells(lr + 1, 1).Select
.Paste
End With
cr.Delete xlShiftToLeft
lastcol = lastcol - 18
Next i
Application.CutCopyMode = False
Application.ScreenUpdating = True

Finish:
TS.UsedRange.Sort Key1:=Range("A1"), Order1:=xlAscending
Exit Sub
End Sub