zaincmt
06-09-2015, 02:53 AM
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.
13638
Area
GpBr
A
U100
A
U101
B
U102
B
U103
C
U104
D
U105
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.
13639
Status
Group
GpBr
Bill To Name
Ticket-Reservation
C Status
R Created Date
D Last Name
C Vehicle Reg
C Number
P Comment
R Comment
S Name
P Number
Extension
Preferences
U100
U101
U102
U101
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.
'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
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.
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 :) x
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.
13638
Area
GpBr
A
U100
A
U101
B
U102
B
U103
C
U104
D
U105
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.
13639
Status
Group
GpBr
Bill To Name
Ticket-Reservation
C Status
R Created Date
D Last Name
C Vehicle Reg
C Number
P Comment
R Comment
S Name
P Number
Extension
Preferences
U100
U101
U102
U101
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.
'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
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.
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 :) x