Autofilter then copy results to new Workbook

'tiz Tastic · Aug 16th 2017

Hello Folks,

Been battling copying the results from a specified worksheet to a new workbook.
Now I know the Autofiltering works fine, but as soon as I start adding copying functions, I get a "Subscript out of range" error starting at IngLastrow and for the life of me, I cannot figure out why.

strStart and strEnd will be user textbox values

Code

Option Explicit
Sub CmdReport_Click()
Dim strStart As String, strEnd As String, strPromptMessage As String
    
    strStart = "2005/08/08"
    
    'Validate the input string
    If Not IsDate(strStart) Then
        strPromptMessage = "Oops! It looks like your entry is not a valid " & _
                           "date. Please retry with a valid date. (YYYY/MM/DD)"
        MsgBox strPromptMessage
        Exit Sub
    End If
    
    strEnd = "2010/08/08"
    
    If Not IsDate(strStart) Then
        strPromptMessage = "Oops! It looks like your entry is not a valid " & _
                           "date. Please retry with a valid date. (YYYY/MM/DD)"
        MsgBox strPromptMessage
        Exit Sub
    End If
    
    Call CreateSubsetWorkbook(strStart, strEnd)
    
End Sub




Public Sub CreateSubsetWorkbook(StartDate As String, EndDate As String)
Dim wbkOutput As Workbook
Dim lngLastRow As Long, lngLastCol As Long, lngDateCol As Long
Dim rngFull As Range, rngResult As Range, rngTarget As Range
    
    lngDateCol = 2
    Set wbkOutput = Workbooks.Add
    
    lngLastRow = Worksheets("DB").Cells.Find(What:="*", LookIn:=xlFormulas, _
                                 SearchOrder:=xlByRows, _
                                 SearchDirection:=xlPrevious).Row
            lngLastCol = Worksheets("DB").Cells.Find(What:="*", LookIn:=xlFormulas, _
                                 SearchOrder:=xlByColumns, _
                                 SearchDirection:=xlPrevious).column
            Set rngFull = Worksheets("DB").Range(Worksheets("DB").Cells(1, 1), Worksheets("DB").Cells(lngLastRow, lngLastCol))
     
    With rngFull
                    .AutoFilter Field:=lngDateCol, _
                            Criteria1:=">=" & StartDate, _
                            Criteria2:="<=" & EndDate
                    
                    Set rngResult = rngFull.SpecialCells(xlCellTypeVisible)
                    rngResult.Copy Workbooks(wbkOutput.Name).Sheets(1).Range("A1")
    End With




                Worksheets("DB").AutoFilterMode = False
                            If Worksheets("DB").FilterMode = True Then
                               Worksheets("DB").ShowAllData
                            End If
    'MsgBox "Data transferred!"




End Sub




Private Sub cmdClose_Click()
    Unload Me
End Sub

Display More

I know it may be cheeky to ask but my next step is to try specify a range to copy and order then like so: B:B,A:A,E:E,D:D,I:I,J:J,AQ:AQ. Doing the selection before copying to the new sheet may complicate things so I was thinking ordering then removing excess columns after being copied?

Any advice, help or suggestions would be greatly appreciated!

Cheers,
Kevin

**Carim** · Aug 16th 2017

Re: Autofilter then copy results to new Workbook

Hello,

Have you tried to remove the instruction

Code

Set wbkOutput = Workbooks.Add

Hope this will help

'tiz Tastic · Aug 16th 2017

Re: Autofilter then copy results to new Workbook

Hi Carim,

Thanks for the quick reply!
Removing the instruction will stop the creation of the new workbook I want created for the filtered data to be copied over to. Perhaps there's a better way to handle this?

**Carim** · Aug 16th 2017

Re: Autofilter then copy results to new Workbook

Hello again,

Sorry ... I meant this instruction should only appear later ... once you have properly define all your variables ...:wink:

'tiz Tastic · Aug 16th 2017

Re: Autofilter then copy results to new Workbook

I have removed the instruction and added the following which is working wonderfully now

Code

rngResult.Copy Workbooks.Add.Sheets(1).Range("A1")

now a Subscript error is occurring when trying to remove the filter and Show all data:

Code

ActiveSheet.AutoFilterMode = False
                            If ActiveSheet.FilterMode = True Then
                            ActiveSheet.ShowAllData
                            End If

What would be the best method to use to select the the original Workbook and filtered worksheet?

Cheers again!

Kevin

**Carim** · Aug 16th 2017

Re: Autofilter then copy results to new Workbook

Hello,

Under these circumstances ... the best solution is to create two variables

Code

Dim wk1 As Workbook
Dim wk2 As Workbook

and set them in your code as soon as possible

Code

Set wk1 = ActiveWorkbook
'and just after you have added your new workbook
Set wk2 = ActiveWorkbook

You can then refer to them with wk1 and wk2 ... as needed

Hope this will help

'tiz Tastic · Aug 16th 2017

Re: Autofilter then copy results to new Workbook

Awesome sauce! I was just working on something quite similar, this looks to be the best approach!
Had some other queries but will raise the questions in a new post if I get stuck.

Thanks again!

**Carim** · Aug 16th 2017

Re: Autofilter then copy results to new Workbook

Glad you could fix your problem ...:wink:

Thank a lot ... for your Thanks ...:smile:

**KjBox** · Aug 16th 2017

Re: Autofilter then copy results to new Workbook

An alternative approach, should be faster and more efficient. Replace your Public Sub CreateSubsetWorkbook procedure with this and the Function

This will also put the filtered data into the new workbook in the required order for the required 7 columns.

Code

Public Sub CreateSubsetWorkbook(startdate As String, enddate As String)
    Dim x, y(), yy, i As Long, ii As Long, iii As Long, wbk As Workbook
    
    Application.ScreenUpdating = 0
    With Sheets("DB").Cells(1).CurrentRegion
        .Parent.AutoFilterMode = False
        x = .Value
        .AutoFilter 2, ">=" & startdate, xlAnd, "<=" & enddate
        For i = 1 To UBound(x, 1)
            If .Rows(i).Hidden = 0 Then
                ii = ii + 1: ReDim Preserve y(1 To 7, 1 To ii)
                y(1, ii) = x(i, 2): y(2, ii) = x(i, 1): y(3, ii) = x(i, 5)
                y(4, ii) = x(i, 4): y(5, ii) = x(i, 9): y(6, ii) = x(i, 10)
                y(7, ii) = x(i, 43)
            End If
        Next
        .Parent.AutoFilterMode = False
    End With
    yy = TransposeArray(y)
    Set wbk = Workbooks.Add
    With wbk.Sheets(1)
        .[a1].Resize(UBound(yy, 1), 7) = yy
        .Columns.AutoFit
    End With
    ThisWorkbook.Activate
    Application.Goto [a1]
    MsgBox "New workbook with filtered data successfully created.", 64, "Workbook Creation."
    
End Sub


Public Function TransposeArray(arr As Variant) As Variant
    Dim i As Long, ii As Long
    ReDim temp(1 To UBound(arr, 2), 1 To UBound(arr, 1))
     
    For i = 1 To UBound(temp, 1)
        For ii = 1 To UBound(temp, 2)
            temp(i, ii) = arr(ii, i)
        Next
    Next
    TransposeArray = temp
     
End Function

Display More

'tiz Tastic · Aug 16th 2017

Re: Autofilter then copy results to new Workbook

Thank's KjBox,

This handles the column selection and reordering magnificently, unfortunately it's copying all records not just the filtered. Also loses the header formatting
Took me a while to figure out what was going on, bit advanced for me (getting back into VBA after being away for yonks)

Cheers,
Kevin

**KjBox** · Aug 16th 2017

Re: Autofilter then copy results to new Workbook

It worked perfectly for me with a sample workbook I knocked up, I am attaching it here. If this works for you then how does the DB sheet in your actual workbook differ from mine?

**KjBox** · Aug 16th 2017

Re: Autofilter then copy results to new Workbook

I just noticed something in my code.

Try changing

Code

If Rows(i).Hidden = 0 Then

to

Code

If .Rows(i).Hidden = 0 Then

In other words put a dot before Rows(i)

This should fix the code for your actual file if the DB sheet is not active when the code runs.

'tiz Tastic · Aug 16th 2017

Re: Autofilter then copy results to new Workbook

Hi KjBox,

I made some minor adjustments which seemed to work, had a "Eureka!" moment but me being a bit daft the DB sheet was active.
Your final adjustment is what did the trick! Thanks a bunch!

Still trying to get my head around the column selection and rearranging..

Thanks again,
Kevin

**KjBox** · Aug 17th 2017

Re: Autofilter then copy results to new Workbook

You're welcome.

The table data is loaded into array x. The code then loops through that array and for table rows that are not hidden (i.e. only the visible rows after filtering) the code increases the 2nd dimension of array y by 1 and adds data from array x to the new second dimension of array y.

This is where the required columns in the required order is done.

The first added data from array x is : y(1, ii) = x(i, 2) so here the data from the second dimension of array x is placed in the first dimension of array y. The 2 in x(i, 2) and the 1 in y(1,ii) means that data from column B of the table will be in Column A of the Result.

The code then works through all 7 levels of the first dimension of array y (that dimension has an upper bound limit of 7 because that is how many columns of data are required) and adds data from the appropriate level (equivalent to column) of the second dimension of array x.

Because it is only possible to increase the second dimension of an array, not the first, array y ends up with the required data transposed (ie. Rows are Columns and Columns are rows). While it is possible to place the data in a transposed array directly onto a sheet by using

Code

Sheet1.[a1].Resize(UBound(y, 2), Ubound(y, 1) = Application.Transpose(y)

but this method sometimes fails for no explicable reason, so I find it safest to use the TransposeArray Function to create a new array that is a transposition of the original array and place that new array onto the sheet.

I hope that helps you understand what is going on with the code.

Autofilter then copy results to new Workbook

Participate now!

Share