VBA - Excel instance after Excel closed by user

W

winshent

New Member
Joined
Jun 30, 2008
Messages
19
I have some code that creates and writes to a workbook from within MS Access..

The code does not save the workbook, so it opens as 'Book1.xls'.

I have added an additional formatting routine that is called for one specific excel export .

If the export does not call the formatting routine, then once the user closes Book1.xls there is no longer an instance of Excel running within task manager, whereas the instance stays open if the formatting routine is called.

This then causes further errors the user attempts to run another export.

Anyone have ideas what is causing this ?

Suspect formatting routine:
Code: 
Public Sub gFormatReportX(pobjWS As Excel.Worksheet)
    
    On Error GoTo ErrHandler
    
    Dim strResponse As String
    Dim strTitle As String
    Dim lngCountTrue   As Long
    Dim lngCountFalse  As Long
    Dim lngCountAll    As Long
    
    Dim i As Long
    Dim j As Long
       
    strResponse = InputBox("Please choose report type", "Enter PSS or AUTH", "AUTH")
    
    If UCase(strResponse) = "AUTH" Then
        GoTo First_Report
    End If
    
    If UCase(strResponse) = "PSS" Then
        GoTo Second_Report
    End If
        MsgBox "Please select a valid report type please try again"
    End 
    
    With pobjWS 
First_Report:
    
        strTitle = .Range("a1")
    
        If .Range("a3").Value = "Request ID" And .Range("C3") = "Requestor" Then
        
            ' MsgBox "Stop Here " & .Range("a3").Value
            '.Range("C:C,D:D,G:G,H:H,J:J,K:K,M:M,P:P,R:R,S:S,T:T,U:U,V:V,W:W,X:X,Y:Y,AB:AB,AE:AE,AF:AF").Select 'Deletes unwanted rows
             
            ' delete all columns from right to left
            
            .Columns(32).Delete Shift:=xlToLeft
            .Columns(31).Delete Shift:=xlToLeft
            .Columns(28).Delete Shift:=xlToLeft
            .Columns(25).Delete Shift:=xlToLeft
            .Columns(24).Delete Shift:=xlToLeft
            .Columns(23).Delete Shift:=xlToLeft
            .Columns(22).Delete Shift:=xlToLeft
            .Columns(21).Delete Shift:=xlToLeft
            .Columns(20).Delete Shift:=xlToLeft
            .Columns(19).Delete Shift:=xlToLeft
            .Columns(18).Delete Shift:=xlToLeft
            .Columns(16).Delete Shift:=xlToLeft
            .Columns(13).Delete Shift:=xlToLeft
            .Columns(11).Delete Shift:=xlToLeft
            .Columns(10).Delete Shift:=xlToLeft
            .Columns(8).Delete Shift:=xlToLeft
            .Columns(7).Delete Shift:=xlToLeft
            .Columns(4).Delete Shift:=xlToLeft
            .Columns(3).Delete Shift:=xlToLeft
            
            
            'Selection.Delete Shift:=xlToLeft
            .Range("a1").Value = strTitle
            .Range("a1").Font.Bold = True
            
            .Range(.Cells(3, 1), .Cells(500, 255)).Sort Key1:=Range("L3"), Order1:=xlAscending, Header:=xlGuess, _
            OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal
            
            .Range("D4").Select
            
            lngCountTrue = 0
            lngCountFalse = 0
            lngCountAll = 0
            
            ' Do Until Selection = "" And Selection.Offset(0, 1) = "" 'Shortens Currency & formats amount
            i = 4
            j = 4
            Do Until .Cells(i, j) = "" And .Cells(i, j + 1) = ""
                
                .Cells(i, j).Value = Left(.Cells(i, j).Value, 3)
                .Cells(i, j - 1).Style = "comma"
                lngCountAll = lngCountAll + 1
                
                If .Cells(i, j + 8).Value = "False" Then
                    lngCountFalse = lngCountFalse + 1
                End If
                
                If .Cells(i, j + 8).Value = "True" Then
                    lngCountTrue = lngCountTrue + 1
                    .Rows(i).Font.Bold = True
                End If
                
                i = i + 1
            Loop
            .Cells(i + 2, j - 1).Value = "Total Count"
            .Cells(i + 2, 0).Value = lngCountAll
            
            .Cells(i + 3, j - 1).Value = "IGT"
            .Cells(i + 3, 0).Value = lngCountTrue
            
            .Cells(i + 4, j - 1).Value = "NON IGT"
            .Cells(i + 4, 0).Value = lngCountFalse
            
            .Range("a1").Select
            
            GoTo CleanExit
        Else
            MsgBox " This is not an original Cash Control Report. No action has been taken"
            GoTo CleanExit
        End If
        
        '==============================================================================================================
        '==== Report No 2
        '==============================================================================================================
                
Second_Report:
        If .Range("a3").Value = "Request ID" And .Range("C3") = "Requestor" Then
            
            ' .Range("A:A,C:C,D:D,G:G,H:H,I:I,J:J,K:K,O:O,P:P,T:T,U:U,V:V,W:W,X:X,Y:Y,Z:Z,AA:AA,AB:AB,AD:AD,AF:AF").Select
            'Selection.Delete Shift:=xlToLeft
            .Range("a1").Value = strTitle
            
            pobjWS.Columns(32).Delete Shift:=xlToLeft
            pobjWS.Columns(30).Delete Shift:=xlToLeft
            pobjWS.Columns(28).Delete Shift:=xlToLeft
            pobjWS.Columns(27).Delete Shift:=xlToLeft
            pobjWS.Columns(26).Delete Shift:=xlToLeft
            pobjWS.Columns(25).Delete Shift:=xlToLeft
            pobjWS.Columns(24).Delete Shift:=xlToLeft
            pobjWS.Columns(23).Delete Shift:=xlToLeft
            pobjWS.Columns(22).Delete Shift:=xlToLeft
            pobjWS.Columns(21).Delete Shift:=xlToLeft
            pobjWS.Columns(20).Delete Shift:=xlToLeft
            pobjWS.Columns(16).Delete Shift:=xlToLeft
            pobjWS.Columns(15).Delete Shift:=xlToLeft
            pobjWS.Columns(11).Delete Shift:=xlToLeft
            pobjWS.Columns(10).Delete Shift:=xlToLeft
            pobjWS.Columns(9).Delete Shift:=xlToLeft
            pobjWS.Columns(8).Delete Shift:=xlToLeft
            pobjWS.Columns(7).Delete Shift:=xlToLeft
            pobjWS.Columns(4).Delete Shift:=xlToLeft
            pobjWS.Columns(3).Delete Shift:=xlToLeft
            pobjWS.Columns(1).Delete Shift:=xlToLeft
            
            ' .Rows("3:500").Select ' Sorts the data by IAT type
            .Range(.Cells(3, 1), .Cells(500, 255)).Sort Key1:=Range("J3"), Order1:=xlAscending, Header:=xlGuess, _
            OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal
            
            .Range("C4").Select
            
            lngCountTrue = 0
            lngCountFalse = 0
            lngCountAll = 0
            
            i = 4
            j = 3
            Do Until .Cells(i, j) = "" And .Cells(i, j + 1) = "" 'Shortens Currency & formats amount
                
                .Cells(i, j).Value = Left(.Cells(i, j), 3)
                .Cells(i, j - 1).Style = "comma"
                lngCountAll = lngCountAll + 1
                
                If .Cells(i, j + 7).Value = "False" Then
                    lngCountFalse = lngCountFalse + 1
                End If
                
                If .Cells(i, j + 7).Value = "True" Then
                    lngCountTrue = lngCountTrue + 1
                    Selection.EntireRow.Font.Bold = True
                End If
                
                i = i + 1
                
            Loop
            
            .Cells(i + 2, j - 1).Value = "Total Count"
            .Cells(i + 2, 0).Value = lngCountAll
            
            .Cells(i + 3, j - 1).Value = "IGT"
            .Cells(i + 3, 0).Value = lngCountTrue
            
            .Cells(i + 4, j - 1).Value = "NON IGT"
            .Cells(i + 4, 0).Value = lngCountFalse
            
            Range("a1").Select
            
            GoTo CleanExit
            
        Else
            MsgBox " This is not an original Cash Control Report. No action has been taken"
            GoTo CleanExit
            
        End If
        
    End With
    
CleanExit:
    Exit Sub
ErrHandler:
    MsgBox "Error occurred producing excel reports - gFormatReportX & vbNewLine & "[" & Err.Number & "] " & Err.Description, vbExclamation
    Resume CleanExit
    Resume
    
    
End Sub
Main Excel Export routine:
Code: 
Public Sub gOpenExcelReport(Optional ByVal pstrSQL As String, _
                            Optional ByVal pstrConn As String, _
                            Optional ByVal pstrRepName As String, _
                            Optional ByVal pblnFormatReportX As Boolean)
                            
    On Error GoTo ErrHandler
    Dim objWs As Excel.Worksheet
    Dim strName As String
    
    If Len(pstrSQL) > 0 Then
        mBuildReportDef pstrSQL, pstrConn
    End If
    
    Set objWs = mobjBuildExcelReport(3, 1)
    
    If Not objWs Is Nothing Then
        strName = "Cash Control Staging Area Report"
        If Len(pstrRepName) > 0 Then
            strName = strName & " - " & pstrRepName
        End If
        strName = strName & " - " & Format(Now, "ddd dd mmm yyyy hh:nn:ss")
        gSetCellProperties objWs, 1, 1, strName, True, 14
        
        If pblnFormatReportX Then
            gblnFormatReportX objWs
        End If
    
    End If
CleanExit:
    On Error Resume Next
    objWs.Application.Visible = True
    Set objWs = Nothing
    On Error GoTo 0
    Exit Sub
ErrHandler:
    MsgBox "Error occurred producing excel reports" & vbNewLine & "[" & Err.Number & "] " & Err.Description, vbExclamation
    Resume CleanExit
    Resume
End Sub
 

Excel Facts

Convert text numbers to real numbers
Select a column containing text numbers. Press Alt+D E F to quickly convert text to numbers. Faster than "Convert to Number"
Sort by date Sort by votes
I have found the issue... Its with the sort function..

Code: 
.Range(.Cells(3, 1), .Cells(500, 255)).Sort Key1:=Range("L3"), Order1:=xlAscending, Header:=xlGuess, _
            OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal

Any idea why this is ?
 
Upvote 0
You forgot to qualify the second range call:

Rich (BB code): 
.Range(.Cells(3, 1), .Cells(500, 255)).Sort Key1:=.Range("L3"), Order1:=xlAscending, Header:=xlGuess, _
            OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal
 
Upvote 0
You must log in or register to reply here.

Similar threads

N
  • Question
VBA Paste Special Error
Replies
1
Views
428
My Aswer Is This
My Aswer Is This
P
  • Question
Help with Vba Code
Replies
3
Views
146
Coyotex3
C
J
  • Question
Issue with Macros and renaming files
Replies
6
Views
478
kevin9999
K
O
  • Solved
VBA: Deleting Visible rows using Auto Filter; Excluding Header
Replies
4
Views
354
mumps
mumps
L
  • Solved
VBA SaveAs
Replies
3
Views
262
Joe4
Joe4

Forum statistics

Threads
1,214,551
Messages
6,120,156
Members
448,948
Latest member
spamiki

Share this page

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