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
 
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

W
  • Solved
Looking For Tips To Improve My VBA
Replies
8
Views
375
who am i
W
J
  • Question Question
VBA or formula to move data in last used column to column A
Replies
5
Views
423
Peter_SSs
Peter_SSs
M
  • Solved
VBA to swap cell values, but enter the swapped value in cell below.
2
Replies
10
Views
892
myall_blues
myall_blues
S
  • Question Question
VBA Copy/Paste from different workbooks
Replies
1
Views
445
NdNoviceHlp
NdNoviceHlp
yearego021
  • Solved
VBA to Save as PDF broken with unwanted deleting of tabs.
Replies
7
Views
264
Artik
Artik

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