Advance Filter Project - OUT of range error

[Ssam87]

Morning / Afternoon everyone,

I have been working on a filtering project over the past few weeks which I have made a lot of progress on thanks to this forum and its awesome users. At this point though I am having a little difficulty implementing it into a larger "worksheet" as stated on this thread heading. When I implement in the code and make the basic changes I get many Out of range errors which I cannot get around.

The Macro is basically being utilised to organise all the data into grouped packages. Basically it is hundreds of columns and hundreds of rows but I only require 3 columns for the task at hand. When trying to implement it in to one of the further columns "In this example column DI1" it shoots up errors stating it is out of range and basically everything I have tried does not allow it to get past it.

I have attached a example spreadsheet with more data like the project which is labelled "Work_Around". I have left my code inside it but just a straight copy from my original working example. In this one I am trying to collate all the data into the grouping packages with the data in column DI and also subtract the desired info from columns U & V and place it all into a new spreadsheet.

Can anyone help me with this "out of range error"

Work_Around.xlsm


Any help will be greatly appreciated.
Sam

[Ssam87]

Incase this helps the following code has been used:

I've gotten a bit further but basically the same error is coming up or only part of the Macro works?

Sub Convert_Test()
 
Dim rdata As Range
Dim filt As Range
Dim dest As Range
Dim uniquework As Range
Dim cwork As Range
Dim rwork As Range
Dim work As String

Clear_Filtered

Worksheets("Data_Master").Activate

    Set rwork = Range(Range("E1"), Range("E1").End(xlDown))
    Set uniquework = Range("A1").End(xlDown).Offset(5, 0)
    Set rdata = Range("A1").CurrentRegion
    rwork.AdvancedFilter xlFilterCopy, , uniquework, True
    Set uniquework = Range(uniquework.Offset(1, 0), uniquework.End(xlDown))
    For Each cwork In uniquework
    work = cwork.Value

    rdata.AutoFilter field:=5, Criteria1:=work
    Set filt = rdata.SpecialCells(xlCellTypeVisible)
    filt.Copy Worksheets("Filtered").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)

    ActiveSheet.AutoFilterMode = False
    
    Next cwork
        With Worksheets("Filtered")
        .Range("a1").EntireColumn.Delete
        .Range("A1:B1").EntireColumn.Cut .Range("E1")
        .Range("A1:C1").EntireColumn.Delete
    End With
    
    Range(Range("a1").End(xlDown).Offset(1, 0), Cells(Rows.Count, "A")).EntireRow.Delete

End Sub

The inparticular part of code that appears to fail and shoot up the out of range error is

    rdata.AutoFilter field:=5, Criteria1:=work

[Ssam87]

Hey guys,

In case anyone is looking at this, there is no need, I have got it to work this morning!

[yogananda.muthaiah]

Hi

Recheck with header i.e field 5 or 115

[Ssam87]

Morning Yogananda, I tried that approach at the very start, it still shot up the error of out of range.