Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

Register Log in
  • Congratulations strongm on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

VBA Quit Excel Type Mismatch Error

Status
Not open for further replies.
baycolor

baycolor

MIS
Mar 23, 2005
148
US
I'm using Microsoft Excel 2003. I've played with this enought and can't figure it out...

Macro code is below. The very first thing my auto run macro does is check to see if a file exists. I'm testing it repeatedly with the file missing so Excel will shutdown (quit).

Each time this code runs I get the following message:
Run-time error '13':
Type mismatch

The way the macro is below I can't get into debug mode - when I click debug the screen flashes up fast and Excel exits. If I comment out Application.DisplayAlerts = False
I can get into debug mode but nothing is highlighted I get put in the editor window half way down my module.

Question 1)
Anyone have any idea what is causing the error and how to get around it (if no file exists I want the macro to end and Excel to close)?

Question 2)
I'm going to run this macro via a scheduled task any thoughts on problems I might have (if any)?

Thanks

Code: 
Sub Auto_Run()

' Check and see if a Crystal Report Excel output file exists ????????.  This file
' is used to populate the raw data worksheet in this book.
    Dim sPath As String
    
    sPath = "C:\Temp\Dougs Files Duns Load\ExcelLoading\CrExportdata.xls"
     
    ' Test if directory or file exists
    If FileOrDirExists(sPath) Then
        MsgBox sPath & " exists!"
    Else
        Application.DisplayAlerts = False
        Application.Quit
    End If
...
...
...
End Sub
 
Sort by date Sort by votes
Try changing the code to this

Code: 
Sub Auto_Run()

' Check and see if a Crystal Report Excel output file exists ????????.  This file
' is used to populate the raw data worksheet in this book.
    Dim sPath As String
    
    sPath = "C:\Temp\Dougs Files Duns Load\ExcelLoading\CrExportdata.xls"
   Dim fso

Set fso = CreateObject("Scripting.FileSystemObject")
If fso.FileExists(sPath) Then
    ' Test if directory or file exists
    
        MsgBox sPath & " exists!"
    Else
        Application.DisplayAlerts = False
        Set fso = Nothing
        Application.Quit
    End If
Set fso = Nothing
End Sub

ck1999
 
Upvote 0 Downvote
Thanks but it didn't seem to work. Tested your recommendation - code I have is:

Code: 
    Dim sPath As String
   
    sPath = "C:\Temp\Dougs Files Duns Load\ExcelLoading\CrExportdata.xls"
     
    Set fso = CreateObject("Scripting.FileSystemObject")
    If fso.FileExists(sPath) Then
        ' Test if directory or file exists
        MsgBox sPath & " exists!"
    Else
        Application.DisplayAlerts = False
        Set fso = Nothing
        Application.Quit
    End If
...
...
...
    Set fso = Nothing

I'm getting the same type mismatch error. Again I can't see where if I comment out the alerts and click Debug. Any other thoughts?

In my first post I failed to show the function that is being called "FileOrDirExists". That function is...

Code: 
Function FileOrDirExists(PathName As String) As Boolean
     
    Dim iTemp As Integer
     
     'Ignore errors to allow for error evaluation
    On Error Resume Next
    iTemp = GetAttr(PathName)
     
     'Check if error exists and set response appropriately
    Select Case Err.Number
    Case Is = 0
        FileOrDirExists = True
    Case Else
        FileOrDirExists = False
    End Select
     
     'Resume error checking
    On Error GoTo 0
End Function
 
Upvote 0 Downvote
What do you mean did not work? results not what you expected? error generated?

It works on my access 2003.

Try dim fso (you left this out)

ck1999
 
Upvote 0 Downvote
Copy the entire "code" screen of my first post and paste it into a new procedure. Do not add or delete anything. Change the procedure name so you do not have two duplicate names and then run just this procedure and see if you get an error.

ck1999
 
Upvote 0 Downvote
Both you "posted" code and mine work. (My code prevents a call to another procedure.) So this is good news!

So why not post the rest of the code so we can see what is not working.

ck1999
 
Upvote 0 Downvote
The first time I incorporated your code I attempted to incorporate it into my original "Auto_Run" procedure and it didn't work (apparently when I did that I left out the dim on the "dim fso"). I added the dim in this scenario and still got the a type mismatch error. Then after reading your post above about I copied your Auto_Run as is and renamed my "Auto_Run" to "PopWrkBook". Also added a line in the true part of the If to call my "PopWrkBook" procedure and everything worked perfectly. Sorry for the confusion I created with the posts. Two blocks of code below... the first is all the code from my original macro which I should have posted in the first place (in case anyone is curious about the macro code that caused the original type mismatch error). The second is the macro code that now works.

Code: 
'****************************************************************************
' Date:         2/26/08
' Author:       Michael T. Smith
' Description:  This workbook works in conjunction with Crytal Reports.
'               Specifically to ???????????????????????????
'               ????????????????????????????????????????????
'               ????????????????????????????????????????????
'****************************************************************************

Sub Auto_Run()

' Check and see if a Crystal Report Excel output file <????? NAME ?????> exists.  This file
' is used to populate the raw data worksheet in this book.
    Dim sPath As String

    sPath = "C:\Temp\Dougs Files Duns Load\ExcelLoading\CrExportdata.xls"

    ' Test if directory or file exists
    If FileOrDirExists(sPath) Then
        MsgBox sPath & " exists!"
    Else
        MsgBox sPath & " does not exist."
        Application.DisplayAlerts = False
        Application.Quit
    End If

' Declare and populate an array with all worksheet names that need to be repopulated.
    Dim aIndWrkShtArr(13)
    
    aIndWrkShtArr(1) = "Finance"
    aIndWrkShtArr(2) = "Comm-Media"
    aIndWrkShtArr(3) = "Gov"
    aIndWrkShtArr(4) = "Healthcare"
    aIndWrkShtArr(5) = "Insurance"
    aIndWrkShtArr(6) = "Mfg"
    aIndWrkShtArr(7) = "Retail"
    aIndWrkShtArr(8) = "Transportation"
    aIndWrkShtArr(9) = "Travel"
    aIndWrkShtArr(10) = "Non-Targeted"
    aIndWrkShtArr(11) = "OtherIndustries"
    aIndWrkShtArr(12) = "Partners+Influencers"
    aIndWrkShtArr(13) = "AllIndustries"

' Unhide raw data sheet and make sure it's empty.  Open new data workbook from Crystal Reports.
' Copy in new workbook data.  Close new workbook.
    Sheets("RawData").Visible = True
    Sheets("RawData").Select
    Cells.Select
    Selection.ClearContents
    Range("A1").Select
    Workbooks.Open Filename:= _
        "C:\Temp\Dougs Files Duns Load\ExcelLoading\CrExportData.xls"
    Cells.Select
    Selection.Copy
    Windows("GetCrData.xls").Activate
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Windows("CrExportData.xls").Close

' Call a procedure that will delete all data from the worksheets.
    EmptyWorksheets (aIndWrkShtArr)

' Sort data in raw data sheet by industry - in preparation for populating individual industry sheets.
    Sheets("RawData").Select
    Cells.Sort Key1:=Range("C1"), Order1:=xlAscending, Key2:=Range("M1"), Order2:=xlDescending, _
        Header:=xlYes, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal

' Loop through the array of sheets and determine which RMDB industry name
' each sheet maps to.  Then call a procedure that will populate each sheet.
    Dim sWrkShtName As String
    For i = 1 To UBound(aIndWrkShtArr)
        Select Case aIndWrkShtArr(i)
            Case "AllIndustries"
                sWrkShtName = aIndWrkShtArr(i)
                PopWorkSheets sWrkShtName, "AllIndustries"
            Case "Finance"
                sWrkShtName = aIndWrkShtArr(i)
                PopWorkSheets sWrkShtName, "Financial"
            Case "Comm-Media"
                sWrkShtName = aIndWrkShtArr(i)
                PopWorkSheets sWrkShtName, "Comm & Media/Ent"
            Case "Gov"
                sWrkShtName = aIndWrkShtArr(i)
                PopWorkSheets sWrkShtName, "Government"
            Case "Healthcare"
                sWrkShtName = aIndWrkShtArr(i)
                PopWorkSheets sWrkShtName, "Healthcare"
            Case "Insurance"
                sWrkShtName = aIndWrkShtArr(i)
                PopWorkSheets sWrkShtName, "Insurance"
            Case "Mfg"
                sWrkShtName = aIndWrkShtArr(i)
                PopWorkSheets sWrkShtName, "Manuf"
            Case "Retail"
                sWrkShtName = aIndWrkShtArr(i)
                PopWorkSheets sWrkShtName, "Retail"
            Case "Transportation"
                sWrkShtName = aIndWrkShtArr(i)
                PopWorkSheets sWrkShtName, "Transportation"
            Case "Travel"
                sWrkShtName = aIndWrkShtArr(i)
                PopWorkSheets sWrkShtName, "Travel"
            Case "Non-Targeted"
                sWrkShtName = aIndWrkShtArr(i)
                PopWorkSheets sWrkShtName, "Non-Target"
            Case "OtherIndustries"
                sWrkShtName = aIndWrkShtArr(i)
                PopWorkSheets sWrkShtName, "Other Industries"
            Case "Partners+Influencers"
                sWrkShtName = aIndWrkShtArr(i)
                PopWorkSheets sWrkShtName, "Partners+Influencers"
        End Select
    Next i

' Call a procedure that will sort format the data in all worksheets.
    FormatWrkSheets (aIndWrkShtArr)
    
' Make sure clipboard is empty before ending.
    Application.CutCopyMode = False
    Set fso = Nothing
End Sub

' Function is passed a path/file name or a directory name and the function returns TRUE if the
' file or directory exists FALSE if it doesn't.
' PathName     : Supports Windows mapped drives or UNC
' File usage   : Provide full file path and extension
' Folder usage : Provide full folder path
'                Accepts with/without trailing "\" (Windows)
'                Accepts with/without trailing ":" (Macintosh)
' In this instance it is passed a path and name of the Crystal Report Excel output file that
' that this workbook uses to populate the hidden RawData tab.

Function FileOrDirExists(PathName As String) As Boolean

    Dim iTemp As Integer

     'Ignore errors to allow for error evaluation
    On Error Resume Next
    iTemp = GetAttr(PathName)

     'Check if error exists and set response appropriately
    Select Case Err.Number
    Case Is = 0
        FileOrDirExists = True
    Case Else
        FileOrDirExists = False
    End Select

     'Resume error checking
    On Error GoTo 0
End Function


' Procedure takes in an array of sheet names and removes all data from each sheet. And activate
' cell A1 in each sheet in preperation for pasting in new industry specific data.
Sub EmptyWorksheets(IndWrkShtArr As Variant)
    For i = 1 To UBound(IndWrkShtArr)
        With Sheets(IndWrkShtArr(i))
            .Cells.ClearContents
            ' Sheets("RawData").Range("A:A").Copy Destination:=.Range("A1")
            Sheets("RawData").Range("1:1").Copy Destination:=.Range("A1")
        End With
    Next i
End Sub

' Procedure is passed an industry worksheet name and a corresponding RMDB industry name.  The
' procedure determines the start and row of the industry data in the raw worksheet, copies those
' rows into the appropriate industry worksheet.
Sub PopWorkSheets(sWrkShtName As String, sIndName As String)
    Dim iRowStartNo As Integer
    Dim iRowLastNo As Integer
    
    ' If the All Industries worksheet is being worked copy in all industry data otherwise just
    ' copy in industry specific data.
    If sWrkShtName = "AllIndustries" Then
        Cells.Select
        Selection.Copy
        Sheets(sWrkShtName).Select
        Range("A1").Select
        ActiveSheet.Paste
        Range("A1").Select
        Sheets("RawData").Select
    Else
        ' Call functions to determine start and end rows. Then select and copy rows into target
        ' industry worksheeet. Put focus back on cell A1 in raw data worksheet (prep for next
        ' pass through).
        iRowStartNo = IndStartRowNo(sIndName)
        iRowLastNo = IndLastRowNo(sIndName)
        Range("A" & iRowStartNo, "N" & iRowLastNo).Select
        Selection.Copy
        Sheets(sWrkShtName).Select
        Range("A2").Select
        ActiveSheet.Paste
        Range("A1").Select
        Sheets("RawData").Select
        Range("A1").Select
    End If
End Sub

' Function returns the row # of the first row that contains the specified
' industry in the industry column of the raw data sheet.
Function IndStartRowNo(sIndustry As String) As Integer
    Columns("C:C").Select
    Selection.Find(What:=sIndustry, After:=ActiveCell, LookIn:=xlFormulas, LookAt _
        :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
        False, SearchFormat:=False).Activate
    IndStartRowNo = ActiveCell.Row
End Function

' Function returns the row # of the last row that contains the specified
' industry in the industry column of the raw data sheet.
Function IndLastRowNo(sIndustry As String) As Integer
    Columns("C:C").Select
    Selection.Find(What:=sIndustry, After:=ActiveCell, LookIn:=xlFormulas, LookAt _
        :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlPrevious, MatchCase:= _
        False, SearchFormat:=False).Activate
    IndLastRowNo = ActiveCell.Row
End Function

' Procedure takes in an array of worksheet names and sorts and formats each.
Sub FormatWrkSheets(IndWrkShtArr As Variant)
    For i = 1 To UBound(IndWrkShtArr)
        Sheets(IndWrkShtArr(i)).Select
        If IndWrkShtArr(i) = "AllIndustries" Then
            Cells.Sort Key1:=Range("M1"), Order1:=xlDescending, Key2:=Range("B1"), Order2:=xlAscending, _
                Header:=xlYes, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
                DataOption1:=xlSortNormal
            Rows("1:1").Select
            Selection.Font.Bold = True
            Cells.Select
            Cells.EntireColumn.AutoFit
            Columns("B:B").Select
            Selection.ColumnWidth = 34.29
            Range("A2").Select
            ActiveWindow.FreezePanes = True
            Range("A1").Select
        End If
        Rows("1:1").Select
        Selection.Font.Bold = True
        Cells.Select
        Cells.EntireColumn.AutoFit
        Columns("B:B").Select
        Selection.ColumnWidth = 34.29
        Range("A2").Select
        ActiveWindow.FreezePanes = True
        Range("A1").Select
    Next i
End Sub

Code that now works....

Code: 
'****************************************************************************
' Date:         2/26/08
' Author:       Michael T. Smith
' Description:  This workbook works in conjunction with Crytal Reports.
'               Specifically.....???????????????????????????
'               ????????????????????????????????????????????
'               ????????????????????????????????????????????
'****************************************************************************
' Check and see if a Crystal Report Excel output file <????? NAME ?????> exists.
' If a file doesn't exist exit and don't repopulate this workbook.
Sub Auto_Run()

    Dim sPath As String
    sPath = "C:\Temp\Dougs Files Duns Load\ExcelLoading\CrExportdata.xls"
    Dim fso
    Set fso = CreateObject("Scripting.FileSystemObject")
    
    ' Test if directory or file exists
    If fso.FileExists(sPath) Then
        PopWrkBook
    Else
        Application.DisplayAlerts = False
        Set fso = Nothing
        Application.Quit
    End If
    
    Set fso = Nothing
End Sub

' Main procedure that is executed to populate this workbook.  Only executed if a
' Crystal Reports Excel output file exists.
Sub PopWrkBook()
    ' Declare and populate an array with all worksheet names that need to be repopulated.
    Dim aIndWrkShtArr(13)
    
    aIndWrkShtArr(1) = "Finance"
    aIndWrkShtArr(2) = "Comm-Media"
    aIndWrkShtArr(3) = "Gov"
    aIndWrkShtArr(4) = "Healthcare"
    aIndWrkShtArr(5) = "Insurance"
    aIndWrkShtArr(6) = "Mfg"
    aIndWrkShtArr(7) = "Retail"
    aIndWrkShtArr(8) = "Transportation"
    aIndWrkShtArr(9) = "Travel"
    aIndWrkShtArr(10) = "Non-Targeted"
    aIndWrkShtArr(11) = "OtherIndustries"
    aIndWrkShtArr(12) = "Partners+Influencers"
    aIndWrkShtArr(13) = "AllIndustries"

    ' Unhide raw data sheet and make sure it's empty.  Open new data workbook from Crystal Reports.
    ' Copy in new workbook data.  Close new workbook.
    Sheets("RawData").Visible = True
    Sheets("RawData").Select
    Cells.Select
    Selection.ClearContents
    Range("A1").Select
    Workbooks.Open Filename:= _
        "C:\Temp\Dougs Files Duns Load\ExcelLoading\CrExportData.xls"
    Cells.Select
    Selection.Copy
    Windows("2WorksGetCrData.xls").Activate
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Windows("CrExportData.xls").Close

    ' Call a procedure that will delete all data from the worksheets.
    EmptyWorksheets (aIndWrkShtArr)

    ' Sort data in raw data sheet by industry - in preparation for populating individual industry sheets.
    Sheets("RawData").Select
    Cells.Sort Key1:=Range("C1"), Order1:=xlAscending, Key2:=Range("M1"), Order2:=xlDescending, _
        Header:=xlYes, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal

    ' Loop through the array of sheets and determine which RMDB industry name
    ' each sheet maps to.  Then call a procedure that will populate each sheet.
    Dim sWrkShtName As String
    For i = 1 To UBound(aIndWrkShtArr)
        Select Case aIndWrkShtArr(i)
            Case "AllIndustries"
                sWrkShtName = aIndWrkShtArr(i)
                PopWorkSheets sWrkShtName, "AllIndustries"
            Case "Finance"
                sWrkShtName = aIndWrkShtArr(i)
                PopWorkSheets sWrkShtName, "Financial"
            Case "Comm-Media"
                sWrkShtName = aIndWrkShtArr(i)
                PopWorkSheets sWrkShtName, "Comm & Media/Ent"
            Case "Gov"
                sWrkShtName = aIndWrkShtArr(i)
                PopWorkSheets sWrkShtName, "Government"
            Case "Healthcare"
                sWrkShtName = aIndWrkShtArr(i)
                PopWorkSheets sWrkShtName, "Healthcare"
            Case "Insurance"
                sWrkShtName = aIndWrkShtArr(i)
                PopWorkSheets sWrkShtName, "Insurance"
            Case "Mfg"
                sWrkShtName = aIndWrkShtArr(i)
                PopWorkSheets sWrkShtName, "Manuf"
            Case "Retail"
                sWrkShtName = aIndWrkShtArr(i)
                PopWorkSheets sWrkShtName, "Retail"
            Case "Transportation"
                sWrkShtName = aIndWrkShtArr(i)
                PopWorkSheets sWrkShtName, "Transportation"
            Case "Travel"
                sWrkShtName = aIndWrkShtArr(i)
                PopWorkSheets sWrkShtName, "Travel"
            Case "Non-Targeted"
                sWrkShtName = aIndWrkShtArr(i)
                PopWorkSheets sWrkShtName, "Non-Target"
            Case "OtherIndustries"
                sWrkShtName = aIndWrkShtArr(i)
                PopWorkSheets sWrkShtName, "Other Industries"
            Case "Partners+Influencers"
                sWrkShtName = aIndWrkShtArr(i)
                PopWorkSheets sWrkShtName, "Partners+Influencers"
        End Select
    Next i

    ' Call a procedure that will sort format the data in all worksheets.
    FormatWrkSheets (aIndWrkShtArr)
    
    ' Make sure clipboard is empty before ending.
    Application.CutCopyMode = False
    Set fso = Nothing
End Sub

' Procedure takes in an array of sheet names and removes all data from each sheet. And activate
' cell A1 in each sheet in preperation for pasting in new industry specific data.
Sub EmptyWorksheets(IndWrkShtArr As Variant)
    For i = 1 To UBound(IndWrkShtArr)
        With Sheets(IndWrkShtArr(i))
            .Cells.ClearContents
            ' Sheets("RawData").Range("A:A").Copy Destination:=.Range("A1")
            Sheets("RawData").Range("1:1").Copy Destination:=.Range("A1")
        End With
    Next i
End Sub

' Procedure is passed an industry worksheet name and a corresponding RMDB industry name.  The
' procedure determines the start and row of the industry data in the raw worksheet, copies those
' rows into the appropriate industry worksheet.
Sub PopWorkSheets(sWrkShtName As String, sIndName As String)
    Dim iRowStartNo As Integer
    Dim iRowLastNo As Integer
    
    ' If the All Industries worksheet is being worked copy in all industry data otherwise just
    ' copy in industry specific data.
    If sWrkShtName = "AllIndustries" Then
        Cells.Select
        Selection.Copy
        Sheets(sWrkShtName).Select
        Range("A1").Select
        ActiveSheet.Paste
        Range("A1").Select
        Sheets("RawData").Select
    Else
        ' Call functions to determine start and end rows. Then select and copy rows into target
        ' industry worksheeet. Put focus back on cell A1 in raw data worksheet (prep for next
        ' pass through).
        iRowStartNo = IndStartRowNo(sIndName)
        iRowLastNo = IndLastRowNo(sIndName)
        Range("A" & iRowStartNo, "N" & iRowLastNo).Select
        Selection.Copy
        Sheets(sWrkShtName).Select
        Range("A2").Select
        ActiveSheet.Paste
        Range("A1").Select
        Sheets("RawData").Select
        Range("A1").Select
    End If
End Sub

' Function returns the row # of the first row that contains the specified
' industry in the industry column of the raw data sheet.
Function IndStartRowNo(sIndustry As String) As Integer
    Columns("C:C").Select
    Selection.Find(What:=sIndustry, After:=ActiveCell, LookIn:=xlFormulas, LookAt _
        :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
        False, SearchFormat:=False).Activate
    IndStartRowNo = ActiveCell.Row
End Function

' Function returns the row # of the last row that contains the specified
' industry in the industry column of the raw data sheet.
Function IndLastRowNo(sIndustry As String) As Integer
    Columns("C:C").Select
    Selection.Find(What:=sIndustry, After:=ActiveCell, LookIn:=xlFormulas, LookAt _
        :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlPrevious, MatchCase:= _
        False, SearchFormat:=False).Activate
    IndLastRowNo = ActiveCell.Row
End Function

' Procedure takes in an array of worksheet names and sorts and formats each.
Sub FormatWrkSheets(IndWrkShtArr As Variant)
    For i = 1 To UBound(IndWrkShtArr)
        Sheets(IndWrkShtArr(i)).Select
        If IndWrkShtArr(i) = "AllIndustries" Then
            Cells.Sort Key1:=Range("M1"), Order1:=xlDescending, Key2:=Range("B1"), Order2:=xlAscending, _
                Header:=xlYes, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
                DataOption1:=xlSortNormal
            Rows("1:1").Select
            Selection.Font.Bold = True
            Cells.Select
            Cells.EntireColumn.AutoFit
            Columns("B:B").Select
            Selection.ColumnWidth = 34.29
            Range("A2").Select
            ActiveWindow.FreezePanes = True
            Range("A1").Select
        End If
        Rows("1:1").Select
        Selection.Font.Bold = True
        Cells.Select
        Cells.EntireColumn.AutoFit
        Columns("B:B").Select
        Selection.ColumnWidth = 34.29
        Range("A2").Select
        ActiveWindow.FreezePanes = True
        Range("A1").Select
    Next i
End Sub
 
Upvote 0 Downvote
Lastly, thanks very much for the help it worked great!
 
Upvote 0 Downvote
If you want "clean up" and speed up your code you can look at remove the calls to activate and select objects.

such as

Columns("B:B").Select
Selection.ColumnWidth = 34.29

replace with
Columns("B:B").ColumnWidth = 34.29

ck1999
 
Upvote 0 Downvote
Correction for your original macro:
Code: 
...
    Else
        Application.DisplayAlerts = False
        Application.Quit
        [!]Exit Sub[/!]
    End If
...

Hope This Helps, PH.
FAQ219-2884
FAQ181-2886
 
Upvote 0 Downvote
Thanks for the help ck1999 and PHV.

Below is hopefully a new more efficient version.

I do have a final question though. This workbook/macro basically does the following:

1)
Workbook exists with one tab of data that contains revenue data for about ten industries.

2)
Workbook exists with another ten tabs of data that contain
revenue data for each individual industry.

3)
Workbook exsits with a hidden "Raw Data" tab.

4)
The macro below is in this workbook and periodically does the following:

a) Opens a raw data workbook from a Crystal Report (CR). Has revenue data for all ten industries in one tab.
b) Copies in all data to the hidden Raw Data tab.
c) Refreshes all data in all eleven tabs.
d) Clears out the raw data copied into the raw data tab
e) Closes the workbook.

The raw data workbook produced by Crystal Reports is 2+ MB (contains all industries revenue data). When the workbook with the macro finishes running the size of it is 13+ MB. In this workbook I basically

- Copied in the raw data from the CR workbook.
2+ MB
- Copied and split it out into individual industry tabs
Now should be about 4+ MB

I understand that there is some overhead with adding ten additional tabs/duplicating the data plus having a hidden raw data tab (although that is empty) but should that equate to an additional 9 MB of file size to make it 13 MB?

I did go into the final workbook and delete the empty raw data tab to see what it would do to the size of the 13 MB file and it reduced it down by about 500k.

The most sensible solution is to not make copies of the industry data into individual tabs and put a filter on the industry column in the "All Industries" tab. But the target audience for this report is not anyone that's going to filter anything.

Is there a way around this?

Thanks


Code: 
'****************************************************************************
' Date        : 2/26/08
' Author      : Michael T. Smith
' File        : rmdbacctindrev.xls
' Description : This workbook works in conjunction with the Crytal Report (CR)
'               rmdbacctindrevrawdata.rpt.  That CR outputs a workbook called
'               rmdbacctindrevrawdata.xls file.  This workbook with an auto_run
'               macro reads in the data from the CR workbook and places it into
'               this workbooks hidden RawData tab.  The data in this tab is then
'               split out and placed into the various industry tabs.  As a last
'               step the RawData tab has all data placed in it removed and the
'               tab is hidden.  Data is removed to reduce the size of the final
'               workbook.
'               Some notes about this macro:
'               1) It relies on hard coded file paths.
'               2) It relies on a standard file name from Crystal Reports.
'               3) It relies on hard coded industry tab names and hard coded
'                  industry names (that match the industry names in the RMDB data.
'               4) It relies on hard coded hard coded RMDB industry names.
'****************************************************************************

' Check and see if a Crystal Report Excel output file rmdbacctindrevrawdata.xls exists.
' If a file doesn't exist exit and don't repopulate this workbook.
Sub Auto_Run()

    Dim sPath As String
    sPath = "C:\Temp\Dougs Files Duns Load\ExcelLoading\rmdbacctindrevrawdata.xls"
    Dim fso
    Set fso = CreateObject("Scripting.FileSystemObject")
    
    ' Test if directory or file exists
    If fso.FileExists(sPath) Then
        PopWrkBook
    Else
        Application.DisplayAlerts = False
        Set fso = Nothing
        Application.Quit
    End If
    
    Set fso = Nothing
    Sheets("RawData").Cells.ClearContents
    Sheets("RawData").Visible = False
End Sub

' Main procedure that is executed to populate this workbook.  Only executed if a
' Crystal Reports Excel output file exists.
Sub PopWrkBook()
    ' Declare and populate an array with all worksheet names that need to be repopulated.
    Dim aIndWrkShtArr(13)
    
    aIndWrkShtArr(1) = "Finance"
    aIndWrkShtArr(2) = "Comm-Media"
    aIndWrkShtArr(3) = "Gov"
    aIndWrkShtArr(4) = "Healthcare"
    aIndWrkShtArr(5) = "Insurance"
    aIndWrkShtArr(6) = "Mfg"
    aIndWrkShtArr(7) = "Retail"
    aIndWrkShtArr(8) = "Transportation"
    aIndWrkShtArr(9) = "Travel"
    aIndWrkShtArr(10) = "Non-Targeted"
    aIndWrkShtArr(11) = "OtherIndustries"
    aIndWrkShtArr(12) = "Partners+Influencers"
    aIndWrkShtArr(13) = "AllIndustries"

    ' Unhide raw data sheet and make sure it's empty.  Open new data workbook from Crystal Reports.
    ' Copy in new workbook data.  Close new workbook.
    Sheets("RawData").Visible = True
    Sheets("RawData").Select
    Cells.ClearContents
    Workbooks.Open Filename:= _
        "C:\Temp\Dougs Files Duns Load\ExcelLoading\rmdbacctindrevrawdata.xls"
    Cells.Copy
    Windows("rmdbacctindrev.xls").Activate
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Windows("rmdbacctindrevrawdata.xls").Close

    ' Call a procedure that will delete all data from the worksheets.
    EmptyWorksheets (aIndWrkShtArr)

    ' Sort data in raw data sheet by industry - in preparation for populating individual industry sheets.
    Sheets("RawData").Select
    Cells.Sort Key1:=Range("C1"), Order1:=xlAscending, Key2:=Range("M1"), Order2:=xlDescending, _
        Header:=xlYes, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal

    ' Loop through the array of sheets and determine which RMDB industry name
    ' each sheet maps to.  Then call a procedure that will populate each sheet.
    Dim sWrkShtName As String
    For i = 1 To UBound(aIndWrkShtArr)
        Select Case aIndWrkShtArr(i)
            Case "AllIndustries"
                sWrkShtName = aIndWrkShtArr(i)
                PopWorkSheets sWrkShtName, "AllIndustries"
            Case "Finance"
                sWrkShtName = aIndWrkShtArr(i)
                PopWorkSheets sWrkShtName, "Financial"
            Case "Comm-Media"
                sWrkShtName = aIndWrkShtArr(i)
                PopWorkSheets sWrkShtName, "Comm & Media/Ent"
            Case "Gov"
                sWrkShtName = aIndWrkShtArr(i)
                PopWorkSheets sWrkShtName, "Government"
            Case "Healthcare"
                sWrkShtName = aIndWrkShtArr(i)
                PopWorkSheets sWrkShtName, "Healthcare"
            Case "Insurance"
                sWrkShtName = aIndWrkShtArr(i)
                PopWorkSheets sWrkShtName, "Insurance"
            Case "Mfg"
                sWrkShtName = aIndWrkShtArr(i)
                PopWorkSheets sWrkShtName, "Manuf"
            Case "Retail"
                sWrkShtName = aIndWrkShtArr(i)
                PopWorkSheets sWrkShtName, "Retail"
            Case "Transportation"
                sWrkShtName = aIndWrkShtArr(i)
                PopWorkSheets sWrkShtName, "Transportation"
            Case "Travel"
                sWrkShtName = aIndWrkShtArr(i)
                PopWorkSheets sWrkShtName, "Travel"
            Case "Non-Targeted"
                sWrkShtName = aIndWrkShtArr(i)
                PopWorkSheets sWrkShtName, "Non-Target"
            Case "OtherIndustries"
                sWrkShtName = aIndWrkShtArr(i)
                PopWorkSheets sWrkShtName, "Other Industries"
            Case "Partners+Influencers"
                sWrkShtName = aIndWrkShtArr(i)
                PopWorkSheets sWrkShtName, "Partners+Influencers"
        End Select
    Next i

    ' Call a procedure that will sort format the data in all worksheets.
    FormatWrkSheets (aIndWrkShtArr)
    
    ' Make sure clipboard is empty before ending.
    Application.CutCopyMode = False
    Set fso = Nothing
End Sub

' Procedure takes in an array of sheet names and removes all data from each sheet. And activate
' cell A1 in each sheet in preperation for pasting in new industry specific data.
Sub EmptyWorksheets(IndWrkShtArr As Variant)
    For i = 1 To UBound(IndWrkShtArr)
        With Sheets(IndWrkShtArr(i))
            .Cells.ClearContents
            Sheets("RawData").Range("1:1").Copy Destination:=.Range("A1")
        End With
    Next i
End Sub

' Procedure is passed an industry worksheet name and a corresponding RMDB industry name.  The
' procedure determines the start and row of the industry data in the raw worksheet, copies those
' rows into the appropriate industry worksheet.
Sub PopWorkSheets(sWrkShtName As String, sIndName As String)
    Dim iRowStartNo As Integer
    Dim iRowLastNo As Integer
    
    ' If the All Industries worksheet is being worked copy in all industry data otherwise just
    ' copy in industry specific data.
    If sWrkShtName = "AllIndustries" Then
        Cells.Copy Destination:=Sheets(sWrkShtName).Range("A1")
        Sheets("RawData").Select
    Else
        ' Call functions to determine start and end rows. Then select and copy rows into target
        ' industry worksheeet. Put focus back on cell A1 in raw data worksheet (prep for next
        ' pass through).
        iRowStartNo = IndStartRowNo(sIndName)
        iRowLastNo = IndLastRowNo(sIndName)
        ' If the start or last row values = 1 the functions that looked for start and loast rows
        ' didn't find any data for the industry being processed.  Skip around the copying and pasting
        ' in this situation and leave an empty tab.
        If (iRowStartNo <> 1 And iRowLastNo <> 1) Then
            Range("A" & iRowStartNo, "N" & iRowLastNo).Copy Destination:=Sheets(sWrkShtName).Range("A2")
            Sheets("RawData").Select
            Range("A1").Select
        End If
    End If
End Sub

' Function returns the row # of the first row that contains the specified
' industry in the industry column of the raw data sheet.
Function IndStartRowNo(sIndustry As String) As Integer
    Columns("C:C").Select
    ' The following find will throw an error if an industry that is being processed is not
    ' found in the RawData tab.  Avoid the error and continue processing.  Any industry that
    ' caused an error will end up with an empty tab of data.
    On Error Resume Next
    Selection.Find(What:=sIndustry, After:=ActiveCell, LookIn:=xlFormulas, LookAt _
        :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
        False, SearchFormat:=False).Activate
    IndStartRowNo = ActiveCell.Row
End Function

' Function returns the row # of the last row that contains the specified
' industry in the industry column of the raw data sheet.
Function IndLastRowNo(sIndustry As String) As Integer
    Columns("C:C").Select
    ' The following find will throw an error if an industry that is being processed is not
    ' found in the RawData tab.  Avoid the error and continue processing.  Any industry that
    ' caused an error will end up with an empty tab of data.
    On Error Resume Next
    Selection.Find(What:=sIndustry, After:=ActiveCell, LookIn:=xlFormulas, LookAt _
        :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlPrevious, MatchCase:= _
        False, SearchFormat:=False).Activate
    IndLastRowNo = ActiveCell.Row
End Function

' Procedure takes in an array of worksheet names and sorts and formats each.
Sub FormatWrkSheets(IndWrkShtArr As Variant)
    For i = 1 To UBound(IndWrkShtArr)
        Sheets(IndWrkShtArr(i)).Select
        If IndWrkShtArr(i) = "AllIndustries" Then
            Cells.Sort Key1:=Range("M1"), Order1:=xlDescending, Key2:=Range("B1"), Order2:=xlAscending, _
                Header:=xlYes, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
                DataOption1:=xlSortNormal
            Rows("1:1").Font.Bold = True
            Rows("1:1").EntireRow.AutoFit
            Cells.EntireColumn.AutoFit
            Columns("B:B").ColumnWidth = 34.29
            ActiveWindow.FreezePanes = True
            Range("A1").Select
        End If
        Rows("1:1").Font.Bold = True
        Rows("1:1").EntireRow.AutoFit
        Cells.EntireColumn.AutoFit
        Columns("B:B").ColumnWidth = 34.29
        ActiveWindow.FreezePanes = True
        Range("A1").Select
    Next i
End Sub
 
Upvote 0 Downvote
You could for "fun" copy your sheets 1 at a time into a new workbook and see what the file size is of the new workbook after all sheets are saved. To make sure your current one is not doing something funny.

ck1999
 
Upvote 0 Downvote
I did copy the sheets and macro into a new workbook. The total size decreased to about what I expected (double the size of my raw data).

The workbook I had been working with must have gotten corrupted even though everything was working fine.

Thanks for all the help.
 
Upvote 0 Downvote
Status
Not open for further replies.

Similar threads

remeng
  • Locked
  • Solved
Run-time error '429': ActiveX component can't create object From Excel to Word
Replies
9
Views
544
remeng
remeng
Andrzejek
  • Locked
  • Question
Data Type in ADODB.Recordset
Replies
6
Views
352
strongm
strongm
remeng
  • Locked
  • Question
Run PowerShell Commands from Excel VBA
Replies
14
Views
1K
dhookom
dhookom
thanhthanh12
  • Locked
  • Question
Help vba
Replies
3
Views
304
combo
combo
f0rg3tfu1
  • Locked
  • Question
VBA Error in Excel
Replies
11
Views
323
combo
combo

Part and Inventory Search

Sponsor

Back
Top