# How do I combine 2 modules in excel macro?



## dippncope (Jan 6, 2009)

How can I combine the following 2 bas files into one? I have a spreadsheet that in column G list cities the spread sheet list over one hundred cities but I only need two cities and the rows for those cities. This is what I have and I would like to combine it into 1 file. It searches the spreadsheet finds the city name in G and copies the row to another worksheet and names the work sheet after the city.
Can any one help this scripting Noob. Thanks
File 1
________________
Attribute VB_Name = "FTW"
Sub Extract_Data()
'this macro assumes that your first row of data is a header row.
'will copy a row from one worksheet, to another blank workbook
'IF there is FORT WASHINGTON in column G
'Variables used by the macro
Application.ScreenUpdating = False
Dim FilterCriteria
Dim CurrentFileName As String
Dim NewFileName As String
Set a = ActiveSheet
'Select Range
'(note you can change this to meet your requirements)
Range("A1:AS4000").Select
'Apply Autofilter
Selection.AutoFilter
FilterCriteria = "FORT WASHINGTON"
'NOTE - this filter is on column G (field:=7), to change
'to a different column you need to change the field number
Selection.AutoFilter field:=7, Criteria1:=FilterCriteria
'Select the visible cells (the filtered data)
Selection.SpecialCells(xlCellTypeVisible).Select
'Copy the cells
Selection.Copy
'Open a new file
'Workbooks.Add Template:="Workbook"
'Get this file's name
'NewFileName = ActiveWorkbook.Name
Sheets.Add().Name = "FORT WASHINGTON"
Set b = ActiveSheet
'Make sure you are in cell A1
Range("A1").Select
'Paste the copied cells
ActiveSheet.Paste
Range("A1").Select 'unselect everything
'Clear the clipboard contents
Application.CutCopyMode = False
'Go back to the original file
'Workbooks(CurrentFileName).Activate
a.Select
Selection.AutoFilter field:=7, Criteria1:=FilterCriteria
Selection.SpecialCells(xlCellTypeVisible).Select
'Clear the autofilter
'Selection.AutoFilter field:=1
'Take the Autofilter off
Selection.AutoFilter
'Go to A1
'Range("A1").Select
Application.ScreenUpdating = True
End
End Sub
_____________
File 2 
_________Attribute VB_Name = "SCHAUMBURG"
Sub Extract_Data()
'this macro assumes that your first row of data is a header row.
'will copy a row from one worksheet, to another blank workbook
'IF there is SCHAUMBURG in column G
'Variables used by the macro
Application.ScreenUpdating = False
Dim FilterCriteria
Dim CurrentFileName As String
Dim NewFileName As String
Set a = ActiveSheet
'Select Range
'(note you can change this to meet your requirements)
Range("A1:AS4000").Select
'Apply Autofilter
Selection.AutoFilter
FilterCriteria = "SCHAUMBURG"
'NOTE - this filter is on column G (field:=7), to change
'to a different column you need to change the field number
Selection.AutoFilter field:=7, Criteria1:=FilterCriteria
'Select the visible cells (the filtered data)
Selection.SpecialCells(xlCellTypeVisible).Select
'Copy the cells
Selection.Copy
'Open a new file
'Workbooks.Add Template:="Workbook"
'Get this file's name
'NewFileName = ActiveWorkbook.Name
Sheets.Add().Name = "SCHAUMBURG"
Set b = ActiveSheet
'Make sure you are in cell A1
Range("A1").Select
'Paste the copied cells
ActiveSheet.Paste
Range("A1").Select 'unselect everything
'Clear the clipboard contents
Application.CutCopyMode = False
'Go back to the original file
'Workbooks(CurrentFileName).Activate
a.Select
Selection.AutoFilter field:=7, Criteria1:=FilterCriteria
Selection.SpecialCells(xlCellTypeVisible).Select
'Clear the autofilter
'Selection.AutoFilter field:=1
'Take the Autofilter off
Selection.AutoFilter
'Go to A1
'Range("A1").Select
Application.ScreenUpdating = True
End
End Sub


----------



## OBP (Mar 8, 2005)

This is not the best Forum to post an Excel thread on as most Excel gurus are on the Business Applications forum.
I mostly program Access but I will at least try and answer your question.
First of all you do not need 2 modules as they basically do exactly the same thing, so the only change appears to be the City name. So you could just add the second module to the first one, deleting the "Dim" statements from the second part and the Filter reset from the first part. The code should then run straight through both sets of code. i.e.

Attribute VB_Name = "FTW"
Sub Extract_Data()
'this macro assumes that your first row of data is a header row.
'will copy a row from one worksheet, to another blank workbook
'IF there is FORT WASHINGTON in column G
'Variables used by the macro
Application.ScreenUpdating = False
Dim FilterCriteria
Dim CurrentFileName As String
Dim NewFileName As String
Set a = ActiveSheet
'Select Range
'(note you can change this to meet your requirements)
Range("A1:AS4000").Select
'Apply Autofilter
Selection.AutoFilter
FilterCriteria = "FORT WASHINGTON"
'NOTE - this filter is on column G (field:=7), to change
'to a different column you need to change the field number
Selection.AutoFilter field:=7, Criteria1:=FilterCriteria
'Select the visible cells (the filtered data)
Selection.SpecialCells(xlCellTypeVisible).Select
'Copy the cells
Selection.Copy
'Open a new file
'Workbooks.Add Template:="Workbook"
'Get this file's name
'NewFileName = ActiveWorkbook.Name
Sheets.Add().Name = "FORT WASHINGTON"
Set b = ActiveSheet
'Make sure you are in cell A1
Range("A1").Select
'Paste the copied cells
ActiveSheet.Paste
Range("A1").Select 'unselect everything
'Clear the clipboard contents
Application.CutCopyMode = False
'Go back to the original file
'Workbooks(CurrentFileName).Activate
a.Select
Range("A1:AS4000").Select
'Apply Autofilter
Selection.AutoFilter
FilterCriteria = "SCHAUMBURG"
'NOTE - this filter is on column G (field:=7), to change
'to a different column you need to change the field number
Selection.AutoFilter field:=7, Criteria1:=FilterCriteria
'Select the visible cells (the filtered data)
Selection.SpecialCells(xlCellTypeVisible).Select
'Copy the cells
Selection.Copy
'Open a new file
'Workbooks.Add Template:="Workbook"
'Get this file's name
'NewFileName = ActiveWorkbook.Name
Sheets.Add().Name = "SCHAUMBURG"
Set b = ActiveSheet
'Make sure you are in cell A1
Range("A1").Select
'Paste the copied cells
ActiveSheet.Paste
Range("A1").Select 'unselect everything
'Clear the clipboard contents
Application.CutCopyMode = False
'Go back to the original file
'Workbooks(CurrentFileName).Activate
a.Select
Selection.AutoFilter field:=7, Criteria1:=FilterCriteria
Selection.SpecialCells(xlCellTypeVisible).Select
'Clear the autofilter
'Selection.AutoFilter field:=1
'Take the Autofilter off
Selection.AutoFilter
'Go to A1
'Range("A1").Select
Application.ScreenUpdating = True
End
End Sub

Obviously I can't test it.


----------



## dippncope (Jan 6, 2009)

That is exactly what I needed. Thank you very much:up:


----------

