VBA to filter data in a source file using data from another workbook then create new filtered data tabs

zaincmt

New Member
Joined
Jun 8, 2015
Messages
14
Hi There,

Ive been asked to organize some daily data and it comes in large bulks of about 6000 rows a day. I need to organize this data into filtered worksheets so as I can send it to each specific area dealing with the reservations. I have been doing it manually for a while now but I know if I can get assistance in creating a VBA module / code to simplify this it would make it a lot easier.


What I am trying to achieve is I have 1 workbook which lists the branches (Column "GpBr") within various areas of business. I would like to use this workbooks list to filter the daily of bulk data I get.


[table="width: 500, class: grid"]
[tr]
[td]Area[/td]
[td]GpBr[/td]
[/tr]
[tr]
[td]A[/td]
[td]U100[/td]
[/tr]
[tr]
[td]A[/td]
[td]U101[/td]
[/tr]
[tr]
[td]B[/td]
[td]U102[/td]
[/tr]
[tr]
[td]C[/td]
[td]U103[/td]
[/tr]
[tr]
[td]B[/td]
[td]U105[/td]
[/tr]
[tr]
[td]C[/td]
[td]U104[/td]
[/tr]
[/table]


So the above is an example of a few branches (Column "GpBr") / Areas they are in the above table is in a workbook called "Branches & Areas.xlsx". So I need a VBA module /button to open up the daily bulk of data, filter the results by branches (Column "GpBr") listed in the above table, sort into individual Areas matching the branches (Column "GpBr") in the above table and copy each area to an individual worksheet in a new workbook. The only tricky bit here is in the daily bulk data there isn't an Area column so I will have to use an "IF" Statement possibly to achieve this. But im really not sure how.


My Daily Bulk Data Source is in a file called "All Data Source.xls" and contains the below headers with about 6000 rows of data.

[table="width: 500, class: grid"]
[tr]
[td]Status[/td]
[td]Group[/td]
[td]GpBr[/td]
[td]Bill To Name[/td]
[td]Ticket-Reservation[/td]
[td]C Status[/td]
[td]R Created Date[/td]
[td]D Last Name[/td]
[td]C Vehicle Reg[/td]
[td]C Number[/td]
[td]P Comment[/td]
[td]R Comment[/td]
[td]S Name[/td]
[td]P Number[/td]
[td]Extension[/td]
[td]Preferences[/td]
[/tr]
[tr]
[td][/td]
[td][/td]
[td][/td]
[td][/td]
[td][/td]
[td][/td]
[td][/td]
[td][/td]
[td][/td]
[td][/td]
[td][/td]
[td][/td]
[td][/td]
[td][/td]
[td][/td]
[td][/td]
[/tr]
[/table]



So when I get this daily data I would like to be able to just save it to my hard drive. Open up my first workbook (the 1st example) - click a button and it pulls all the information from the above workbook into new workbook, filtered by Branches (Column "GpBr") that ONLY appear in my "Branches & Areas.xlsx" (top example) and then save the filtered branches (Column "GpBr") into their specific Area which will be put into Area specific worksheets.


I have tried to find various modules and I found a button module which uses a text box input. Like this.

Code:
'In a Standard Module
 
Option Explicit 
Function FilterAndCopy(rng As Range, Choice As String) 
     
    Dim FiltRng As Range 
     'Clear Contents to show just new search data
    Worksheets("Sheet2").Cells.ClearContents 
     'Set the column to filter (In This Case 1 or A)
     'Change as required
    rng.AutoFilter Field:=1, Criteria1:=Choice 
    On Error Resume Next 
    Set FiltRng = rng.SpecialCells(xlCellTypeVisible).EntireRow 
    On Error GoTo 0 
     
     'Copy Data across to sheet 2
    FiltRng.Copy Worksheets("Sheet2").Range("A1") 
     'Display Data
    Worksheets("Sheet2").Select 
    Range("A1").Select 
    Set FiltRng = Nothing 
End Function 
 
Sub formshow() 
     'Show Search Form
    UserForm1.Show 
End Sub 
 
 '*****************************************************************
 'In a userform
 
Option Explicit 
 
Private Sub CommandButton1_Click() 
    Dim rng As Range 
     
     'Set Error Handling
On Error GoTo ws_exit: 
    Application.EnableEvents = False 
     'Set Range
    Set rng = ActiveSheet.UsedRange 
     'Cancel if no value entered in textbox
If TextBox1.Value = "" Then GoTo ws_exit: 
     'Call function Filterandcopy
    FilterAndCopy rng, TextBox1.Value 
    rng.AutoFilter 
     'Exit sub
ws_exit: 
    Set rng = Nothing 
    Application.EnableEvents = True 
    Unload Me 
End Sub 
 
Private Sub CommandButton2_Click() 
     'Cancel Button
    Unload Me 
End Sub 


Source: http://www.vbaexpress.com/kb/getarticle.php?kb_id=786 

How to use: 
 

1.Open Microsoft Excel 
2.Press Alt + F11 to open the Visual Basic Editor (VBE) 
3.Add a new standard module (Top Left) 
4.Copy the In a Standard Module code above into the right pain 
5.Paste code into the right pane 
6.Add a new userform (Top Left) 
7.add two button and a text box to your userform 
8.double click anywhere on the userform 
9.Copy the userform code above into the right pain 
10.Return to excel and add a button 
11.Attach Macro formshow to button 
12.Thats it, it will now search the sheet with the button on and return the results 
13.Results returned to Sheet2 so you must ensure you have a worksheet called Sheet2
  
 

Test the code: 
 

1.Enter data onto sheet with button on 
2.Click Button 
3.Userform will now be displayed 
4.Enter search criteria in textbox (Searches Column A) 
5.HIt Search Button 
6.Your results will now be displayed


but the above code only works if I have the code in the daily bulk file. I don't know how to get it to search another workbook. But I also found this code.


Code:
Sub Extract_All_Data_To_New_Workbook()
    
    'this macro assumes that your first row of data is a header row.
    'will copy all filtered rows from one worksheet, to another blank workbook
    'each unique filtered value will be copied to it's own workbook
    
    'Variables used by the macro
    Dim wbDest As Workbook
    Dim rngFilter As Range, rngUniques As Range
    Dim cell As Range
    
    ' Set the filter range (from A1 to the last used cell in column A)
    '(Note: you can change this to meet your requirements)
    Set rngFilter = Range("A1", Range("A" & Rows.Count).End(xlUp))
    
    Application.ScreenUpdating = False
    
    With rngFilter
        
        ' Filter column A to show only one of each item (uniques) in column A
        .AdvancedFilter Action:=xlFilterInPlace, Unique:=True
        
        ' Set a variable to the Unique values
        Set rngUniques = Range("A2", Range("A" & Rows.Count).End(xlUp)).SpecialCells(xlCellTypeVisible)
        
        ' Clear the filter
        ActiveSheet.ShowAllData
        
    End With
    
    ' Filter, Copy, and Paste each unique to its own new workbook
    For Each cell In rngUniques
    
        ' Create a new workbook for each unique value
        Set wbDest = Workbooks.Add(xlWBATWorksheet)
                
        'NOTE - this filter is on column A (field:=1), to change
        'to a different column you need to change the field number
        rngFilter.AutoFilter Field:=1, Criteria1:=cell.Value
        
        ' Copy and paste the filtered data to its new workbook
        rngFilter.EntireRow.Copy
        With wbDest.Sheets(1).Range("A1")
            .PasteSpecial xlPasteColumnWidths           'Paste column widths
            .PasteSpecial xlPasteValuesAndNumberFormats 'Paste values
        End With
        Application.CutCopyMode = True
        
        ' Name the destination sheet
        wbDest.Sheets(1).Name = cell.Value
        
        'Save the destination workbook and close
        wbDest.SaveAs ThisWorkbook.Path & Application.PathSeparator & _
            cell.Value & " " & Format(Date, "mmm_dd_yyyy")
'        wbDest.Close False 'Close the new workbook
        
    Next cell
    
    rngFilter.Parent.AutoFilterMode = False
    Application.ScreenUpdating = True
    
End Sub

I believe the above code is more suitable but again I don't know how to put it into my "Branches & Areas.xlsx" workbook to filter the bulk data from "All Data Source.xls" by branch and then create a new Workbook with branches (Column "GpBr") put into their rightfull areas into individual worksheets.

Any help would be grateful.

Thank you kindly

Sara
 

Excel Facts

What is =ROMAN(40) in Excel?
The Roman numeral for 40 is XL. Bill "MrExcel" Jelen's 40th book was called MrExcel XL.

Forum statistics

Threads
1,223,228
Messages
6,170,871
Members
452,363
Latest member
merico17

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top