Different Macro outputs

[dgroman]

I have a data base with a macro in it, What it does is it takes data from a region (and the states within the region) and puts it into an excel output file.

What I did was save the data base four times, each one with a macro specific to the four regions of the country. What I want to do is combine the four macros.


My problem is that each macro has to put data into different excel files, this wasn't a problem when I had four separate data bases, each with their own macro in each. Combining the 4 macros into the one data base and making sure each macro puts the data into the separate files is not working though, any suggestions?


This is the code I'm using that indicates the output file.


<code>
Sub insert_exhibits(source_range As String, output_range As String, source_worksheet As String, output_worksheet As String)
'Set xl = CreateObject("Excel.Application")

Source = ThisWorkbook.Name

file_path = ThisWorkbook.Path

Output_File = "Exhibits Midwest.xls"

'Workbooks.Open Filename:=Output_File

Visible = True

Workbooks(Output_File).Sheets(output_worksheet).Range(output_range) = _
Workbooks(Source).Sheets(source_worksheet).Range(source_range).Value

End Sub
<end code>

The output file of "Exhibits Midwest.xls" is only one of the four out put files,
the other are the Northeast, South and West.

If you have any suggestions they would be greatly appreciated, I'm kind of new to VBA still and I'm sure the answer is simple, I just simply don't know enough about VBA yet.

 

[pbornemeier]

I think this will do what you are asking for. Assumptions are shown as comments in the code.

Option Explicit

Sub Main()

    Dim iX As Integer
    Dim sRegion As String
    Dim lLastDataRow As Long
    Dim lLastDataColumn As Long
    Dim lCountVisibleRowsWithData As Long
    
    For iX = 1 To 4
    
        ActiveSheet.AutoFilterMode = False
    
        Select Case iX
        Case 1
            sRegion = "Midwest"
        Case 2
            sRegion = "Northeast"
        Case 3
            sRegion = "South"
        Case 4
            sRegion = "West"
        Case Else
            MsgBox "Error"
            GoTo End_Sub
        End Select
        
        'Determine size of data block
        'ASSUMES COLUMN A AND ROW 1 COVER THE FULL HEIGHT AND WIDTH OF DATA
        lLastDataRow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
        lLastDataColumn = ActiveSheet.Cells(1, Columns.Count, 1).End(xlUp).Column
        
        'Filter data SO ONLY ONE REGION IS VIVIBLE
        'ASSUMES COLUMN B (FIELD 2) CONTAINS THE REGION VALUE
        Range(Cells(1, 1), Cells(lLastDataRow, lLastDataColumn)).AutoFilter Field:=2, Criteria1:=sRegion
        
        'How many rows are visible?  ASSUMES COLUMN B HAS NO BLANK CELLS IN DATA AREA
        lCountVisibleRowsWithData = WorksheetFunction.Subtotal(3, Columns(2))
        
        If lCountVisibleRowsWithData > 1 Then  'More than just header row is showing
        
            'Copy visible data
            Range(Cells(1, 1), Cells(lLastDataRow, lLastDataColumn)).SpecialCells(xlCellTypeVisible).Copy
        
            Sheets.Add                  'Add a blank worksheet, make it the activesheet
            ActiveSheet.Paste           'Paste copied data to A1 of the activesheet
            ActiveSheet.Name = sRegion  'Rename activesheet
            ActiveSheet.Move            'Move activesheet to new workbook
            ActiveWorkbook.SaveAs Filename:= _
                ThisWorkbook.Path & "\Exhibits " & sRegion & ".xls", FileFormat:=xlNormal, _
                Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _
                CreateBackup:=False     'Save new workbook
            ActiveWindow.Close          'close new workbook
            
        Else
        
            MsgBox "No data for region: " & sRegion
            
        End If
    
    Next

End_Sub:

    ActiveSheet.AutoFilterMode = False

End Sub