ACCESS VBA - Code won't run more than once when importing data from excel

R

RCBricker

Well-known Member
Joined
Feb 4, 2003
Messages
1,560
I have a form that imports data from excel. These are monthly imports and should only need to be run once. On the off chance that it needs to be run more than once at a time, I would very much like it to do so.

The code will run once, but then when I run it the second time it hangs up on finding the last row of data on the first worksheet of the new file. IF I hit the reset button in the VBE and start over it runs fine.

Here is the code

Code: 
Public Sub Import_Data()

Dim objEXCEL As Object, fdlg As Object
Dim wbIMPORT As Excel.Workbook
Dim ws As Excel.Worksheet
Dim appEXCEL As Excel.Application
Dim db As DAO.Database
Dim strMONTH As String, strYEAR As String, strMON As String, strMONNUM As String, _
    strFNAME1 As String, strFULLPATH As String, strDATA As String, _
    strTBLNAME As String, strFEED As String
Dim varI As Variant, varJ As Variant
Dim rng As Range, cell As Range, rng1 As Range, cell1 As Range, rngNAME As Range
Dim lngROW As Long, lngCOL As Long
Dim intAMT As Integer, intLMT As Integer, intMATDCAS As Integer, _
    intMATFEED As Integer, intMATQDD As Integer, intMATDAI As Integer, _
    charCNT As Integer
Const strFNAMEST = "RAW DATA_CBDP_"
Const strFNAMEEXT = ".xlsx"
Const strFPATH = "C:\Users\RBRICKER\Desktop\AURD\"
Const strMONMAR = " - Header Fixed"
Const strAPPQ = "TBL_AuRD_"

'*************************************************************************************
'   add strCAT to the code to accomodate the various reconciliation and data sets
'*************************************************************************************

Set ws = Nothing
Set wbIMPORT = Nothing
Set appEXCEL = Nothing

Set db = CurrentDb

strMONTH = Forms![FRM_IMPORT]![CmBo_Month].Column(1)
strYEAR = Forms![FRM_IMPORT]![TXT_Year]

Select Case strMONTH
    Case "January"
        strMON = "JAN"
        strMONNUM = "01"
        strYEAR = strYEAR
    Case "February"
        strMON = "FEB"
        strMONNUM = "02"
        strYEAR = strYEAR
    Case "March"
        strMON = "MAR"
        strMONNUM = "03"
        strYEAR = strYEAR
    Case "April"
        strMON = "APR"
        strMONNUM = "04"
        strYEAR = strYEAR
    Case "May"
        strMON = "MAY"
        strMONNUM = "05"
        strYEAR = strYEAR
    Case "June"
        strMON = "JUN"
        strMONNUM = "06"
        strYEAR = strYEAR
    Case "July"
        strMON = "JUL"
        strMONNUM = "07"
        strYEAR = strYEAR
    Case "August"
        strMON = "AUG"
        strMONNUM = "08"
        strYEAR = strYEAR
    Case "September"
        strMON = "SEPT"
        strMONNUM = "09"
        strYEAR = strYEAR
    Case "October"
        strMON = "OCT"
        strMONNUM = "10"
        strYEAR = strYEAR - 1
    Case "November"
        strMON = "NOV"
        strMONNUM = "11"
        strYEAR = strYEAR - 1
    Case "December"
        strMON = "DEB"
        strMONNUM = "12"
        strYEAR = strYEAR - 1
End Select

If strMONNUM = "03" Then
    strFNAME1 = strFNAMEST & strYEAR & strMONNUM & strMONMAR
Else
    strFNAME1 = strFNAMEST & strYEAR & strMONNUM
End If
strFULLPATH = strFPATH & strFNAME1 & strFNAMEEXT

If appEXCEL Is Nothing Then
    Set appEXCEL = New Excel.Application
End If

With appEXCEL
    .DisplayAlerts = False
    .Visible = True
    '.ScreenUpdating = False
End With

Set wbIMPORT = appEXCEL.WORKBOOKS.Open(strFULLPATH)
strFNAME1 = strFNAME1 & "Upload"
strFULLPATH = strFPATH & strFNAME1 & strFNAMEEXT
wbIMPORT.SaveAs FileName:=strFULLPATH
wbIMPORT.Activate
For Each ws In wbIMPORT.Worksheets
varI = 0
If Not Left(ws.Name, 6) = "Acerno" Then
    ws.Select
    With ws
        lngROW = Range("A" & .Rows.Count).End(xlUp).Row
        If lngROW = 1 Or Left(Range("A" & lngROW).Value, 2) = "NO" Then
            varI = 1
        End If
    End With
    
    If Not varI > 0 Then
        With ws
            lngCOL = Cells(1, .Columns.Count).End(xlToLeft).Column
            lngROW = Range("A" & .Rows.Count).End(xlUp).Row
            Set rng = Range(.Cells(1, 1), .Cells(1, lngCOL))
            
            Select Case Right(ws.Name, 4)
                Case "_DAI"
                    strFEED = "DAI"
                    varI = InStr(1, ws.Name, "_")
                    varI = varI - 1
                    strDATA = Left(ws.Name, varI)
                    
                    varJ = 1
                
                    For Each cell In rng
                        Select Case cell.Value
                            Case "AMT"
                                intAMT = cell.Column
                            Case "LIMIT"
                                intLMT = cell.Column
                            Case "c_MATCHED_DCAS", "MATCHALL_DCAS", _
                                    "MATCHED_DCAS"
                            
                                intMATDCAS = cell.Column
                            Case "C_MATCHALL_QDD", "MATCHALL_QDD"
                                intMATQDD = cell.Column
                            Case "MATCHED_CAPS"
                                intMATFEED = cell.Column
                        End Select
                    Next cell
                    
                    If Not intAMT = 0 Then
                        Set rng = Cells(1, lngCOL + 1)
                        rng.Value = "DB_Amount"
                        Set rng1 = Range(.Cells(2, rng.Column), _
                            .Cells(lngROW, rng.Column))
                    
                        For Each cell1 In rng1
                            cell1.Value = Cells(cell1.Row, intAMT).Value
                        Next cell1
                    End If
                    
                    If Not intLMT = 0 Then
                        Set rng = rng.Offset(, 1)
                        rng.Value = "DB_Limit"
                        Set rng1 = Range(.Cells(2, rng.Column), _
                            .Cells(lngROW, rng.Column))
                    
                        For Each cell1 In rng1
                            cell1.Value = "'" & Cells(cell1.Row, intLMT).Value
                        Next cell1
                    End If
                    
                    If Not intMATDCAS = 0 Then
                        Set rng = rng.Offset(, 1)
                        rng.Value = "DB_Match_Source"
                        Set rng1 = Range(.Cells(2, rng.Column), _
                            .Cells(lngROW, rng.Column))
                    
                        For Each cell1 In rng1
                            cell1.Value = "'" & Cells(cell1.Row, intMATDCAS).Value
                        Next cell1
                    End If
                    
                    If Not intMATFEED = 0 Then
                        Set rng = rng.Offset(, 1)
                        rng.Value = "DB_Match_Source"
                        Set rng1 = Range(.Cells(2, rng.Column), _
                            .Cells(lngROW, rng.Column))
                    
                        For Each cell1 In rng1
                            cell1.Value = "'" & Cells(cell1.Row, intMATFEED).Value
                        Next cell1
                    End If
                    
                    If Not intMATQDD = 0 Then
                        Set rng = rng.Offset(, 1)
                        rng.Value = "DB_Match_QDD"
                        Set rng1 = Range(.Cells(2, rng.Column), _
                            .Cells(lngROW, rng.Column))
                    
                        For Each cell1 In rng1
                            cell1.Value = "'" & Cells(cell1.Row, intMATQDD).Value
                        Next cell1
                    End If
                    Set rng = rng.Offset(, 1)
                    rng.Value = "DB_FEEDER_SYSTEM"
                    Set rng1 = Range(.Cells(2, rng.Column), _
                        .Cells(lngROW, rng.Column))
                    For Each cell1 In rng1
                        cell1.Value = strDATA
                    Next cell1
                    
                    Set rng = rng.Offset(, 1)
                    rng.Value = "DB_PERIOD"
                    Set rng1 = Range(.Cells(2, rng.Column), _
                        .Cells(lngROW, rng.Column))
                    For Each cell1 In rng1
                        cell1.Value = strMON & strYEAR
                    Next cell1
                Case "DCAS"
                    strFEED = "DCAS"
                    varI = InStr(1, ws.Name, "_")
                    varI = varI - 1
                    strDATA = Left(ws.Name, varI)
                    
                    varJ = 1
                
                    For Each cell In rng
                        Select Case cell.Value
                            Case "Trns_Amt"
                                intAMT = cell.Column
                            Case "Sub_Lim"
                                intLMT = cell.Column
                            Case "c_MATCHALL_DCAS", "MATCHALL_DCAS", _
                                    "MATCHALL_DCAS_IPAC"
                
                                intMATDCAS = cell.Column
                            Case "MATCHED_QDD"
                                intMATQDD = cell.Column
                            Case "c_MATCHED_ONEPAY", "MATCHED_MOCAS", _
                                    "c_MATCHED_MOCAS", "MATCHED_IPAC", _
                                    "c_MATCHED_IPAC", "c_MATCHED_IATS", _
                                    "c_MATCHED_IAPS", "c_MATCHED_CAPSW"
                
                                intMATFEED = cell.Column
                            Case "c_MATCHED_DAI"
                                intMATDAI = cell.Column
                        End Select
                    Next cell
                    
                    If Not intAMT = 0 Then
                        Set rng = Cells(1, lngCOL + 1)
                        rng.Value = "DB_Amount"
                        Set rng1 = Range(.Cells(2, rng.Column), _
                            .Cells(lngROW, rng.Column))
                    
                        For Each cell1 In rng1
                            cell1.Value = Cells(cell1.Row, intAMT).Value
                        Next cell1
                    End If
                    
                    If Not intLMT = 0 Then
                        Set rng = rng.Offset(, 1)
                        rng.Value = "DB_Limit"
                        Set rng1 = Range(.Cells(2, rng.Column), _
                            .Cells(lngROW, rng.Column))
                    
                        For Each cell1 In rng1
                            cell1.Value = "'" & Cells(cell1.Row, intLMT).Value
                        Next cell1
                    End If
                    
                    If Not intMATDCAS = 0 Then
                        Set rng = rng.Offset(, 1)
                        rng.Value = "DB_Match_Source"
                        Set rng1 = Range(.Cells(2, rng.Column), _
                            .Cells(lngROW, rng.Column))
                    
                        For Each cell1 In rng1
                            cell1.Value = "'" & Cells(cell1.Row, intMATDCAS).Value
                        Next cell1
                    End If
                    
                    If Not intMATFEED = 0 Then
                        Set rng = rng.Offset(, 1)
                        rng.Value = "DB_Match_Source"
                        Set rng1 = Range(.Cells(2, rng.Column), _
                            .Cells(lngROW, rng.Column))
                    
                        For Each cell1 In rng1
                            cell1.Value = "'" & Cells(cell1.Row, intMATFEED).Value
                        Next cell1
                    End If
                    
                    If Not intMATQDD = 0 Then
                        Set rng = rng.Offset(, 1)
                        rng.Value = "DB_Match_QDD"
                        Set rng1 = Range(.Cells(2, rng.Column), _
                            .Cells(lngROW, rng.Column))
                    
                        For Each cell1 In rng1
                            cell1.Value = "'" & Cells(cell1.Row, intMATQDD).Value
                        Next cell1
                    End If
                    
                    If Not intMATDAI = 0 Then
                        Set rng = rng.Offset(, 1)
                        rng.Value = "DB_Match_DAI"
                        Set rng1 = Range(.Cells(2, rng.Column), _
                            .Cells(lngROW, rng.Column))
                    
                        For Each cell1 In rng1
                            cell1.Value = "'" & Cells(cell1.Row, intMATDAI).Value
                        Next cell1
                    End If
                    
                    Set rng = rng.Offset(, 1)
                    rng.Value = "DB_FEEDER_SYSTEM"
                    Set rng1 = Range(.Cells(2, rng.Column), _
                        .Cells(lngROW, rng.Column))
                    For Each cell1 In rng1
                        cell1.Value = strDATA
                    Next cell1
                    
                    Set rng = rng.Offset(, 1)
                    rng.Value = "DB_PERIOD"
                    Set rng1 = Range(.Cells(2, rng.Column), _
                        .Cells(lngROW, rng.Column))
                    For Each cell1 In rng1
                        cell1.Value = strMON & strYEAR
                    Next cell1
                Case Else
                    If Not Left(ws.Name, 4) = "CAPS" Then
                        strDATA = ws.Name
                    Else
                        strDATA = "CAPS-W"
                    End If
                    varJ = 2
                    
                    Select Case Left(ws.Name, 4)
                        Case "IPAC"
                            For Each cell In rng
                                Select Case cell.Value
                                    Case "sAmt"
                                        intAMT = cell.Column
                                    Case "SubHead"
                                        intLMT = cell.Column
                                    Case "c_MATCHED_DCAS"
                                        intMATDCAS = cell.Column
                                    Case "c_MATCHALL_IPAC", "MATCHALL_IPAC"
                                        intMATFEED = cell.Column
                                End Select
                            Next cell
                    
                            If Not intAMT = 0 Then
                                Set rng = Cells(1, lngCOL + 1)
                                rng.Value = "DB_Amount"
                                Set rng1 = Range(.Cells(2, rng.Column), _
                                    .Cells(lngROW, rng.Column))
                            
                                For Each cell1 In rng1
                                    cell1.Value = Cells(cell1.Row, intAMT).Value
                                Next cell1
                            End If
                    
                            If Not intLMT = 0 Then
                                Set rng = rng.Offset(, 1)
                                rng.Value = "DB_Limit"
                                Set rng1 = Range(.Cells(2, rng.Column), _
                                    .Cells(lngROW, rng.Column))
                            
                                For Each cell1 In rng1
                                    cell1.Value = "'" & Cells(cell1.Row, _
                                        intLMT).Value
                                Next cell1
                            End If
                    
                            If Not intMATFEED = 0 Then
                                Set rng = rng.Offset(, 1)
                                rng.Value = "DB_Match_FEED"
                                Set rng1 = Range(.Cells(2, rng.Column), _
                                    .Cells(lngROW, rng.Column))
                            
                                For Each cell1 In rng1
                                    cell1.Value = "'" & Cells(cell1.Row, _
                                        intMATFEED).Value
                                Next cell1
                            End If
                    
                            Set rng = rng.Offset(, 1)
                            rng.Value = "DB_PERIOD"
                            Set rng1 = Range(.Cells(2, rng.Column), _
                                .Cells(lngROW, rng.Column))
                            For Each cell1 In rng1
                                cell1.Value = strMON & strYEAR
                            Next cell1
                        Case "MOCAS"
                            For Each cell In rng
                                Select Case cell.Value
                                    Case "AMT", "TRANS_AMOUNT_2"
                                        intAMT = cell.Column
                                    Case "LIMIT"
                                        intLMT = cell.Column
                                    Case "c_MATCHED_DCAS"
                                        intMATDCAS = cell.Column
                                    Case "c_MATCHALL_MOCAS", "MATCHALL_MOCAS"
                                        intMATFEED = cell.Column
                                    End Select
                            Next cell
                    
                            If Not intAMT = 0 Then
                                Set rng = Cells(1, lngCOL + 1)
                                rng.Value = "DB_Amount"
                                Set rng1 = Range(.Cells(2, rng.Column), _
                                    .Cells(lngROW, rng.Column))
                            
                                For Each cell1 In rng1
                                    cell1.Value = Cells(cell1.Row, intAMT).Value
                                Next cell1
                            End If
                    
                            If Not intLMT = 0 Then
                                Set rng = rng.Offset(, 1)
                                rng.Value = "DB_Limit"
                                Set rng1 = Range(.Cells(2, rng.Column), _
                                    .Cells(lngROW, rng.Column))
                            
                                For Each cell1 In rng1
                                    cell1.Value = "'" & Cells(cell1.Row, _
                                        intLMT).Value
                                Next cell1
                            End If
                    
                            If Not intMATFEED = 0 Then
                                Set rng = rng.Offset(, 1)
                                rng.Value = "DB_Match_FEED"
                                Set rng1 = Range(.Cells(2, rng.Column), _
                                    .Cells(lngROW, rng.Column))
                            
                                For Each cell1 In rng1
                                    cell1.Value = "'" & Cells(cell1.Row, intMATFEED).Value
                                Next cell1
                            End If
                    
                            Set rng = rng.Offset(, 1)
                            rng.Value = "DB_PERIOD"
                            Set rng1 = Range(.Cells(2, rng.Column), _
                                .Cells(lngROW, rng.Column))
                            For Each cell1 In rng1
                                cell1.Value = strMON & strYEAR
                            Next cell1
                    
                        Case "IAPS"
                            For Each cell In rng
                                Select Case cell.Value
                                    Case "AMT", "TRANS_AMOUNT", "TRANS_AMOUNT_2"
                                        intAMT = cell.Column
                                    Case "c_LIMIT"
                                        intLMT = cell.Column
                                    Case "c_MATCHED_DCAS"
                                        intMATDCAS = cell.Column
                                    Case "c_MATCHALL_IAPS"
                                        intMATFEED = cell.Column
                                    End Select
                            Next cell
                            
                            If Not intAMT = 0 Then
                                Set rng = Cells(1, lngCOL + 1)
                                rng.Value = "DB_Amount"
                                Set rng1 = Range(.Cells(2, rng.Column), _
                                    .Cells(lngROW, rng.Column))
                            
                                For Each cell1 In rng1
                                    cell1.Value = Cells(cell1.Row, intAMT).Value
                                Next cell1
                            End If
                            
                            If Not intLMT = 0 Then
                                Set rng = rng.Offset(, 1)
                                rng.Value = "DB_Limit"
                                Set rng1 = Range(.Cells(2, rng.Column), _
                                    .Cells(lngROW, rng.Column))
                            
                                For Each cell1 In rng1
                                    cell1.Value = "'" & Cells(cell1.Row, _
                                        intLMT).Value
                                Next cell1
                            End If
                            
                            If Not intMATFEED = 0 Then
                                Set rng = rng.Offset(, 1)
                                rng.Value = "DB_Match_FEED"
                                Set rng1 = Range(.Cells(2, rng.Column), _
                                    .Cells(lngROW, rng.Column))
                            
                                For Each cell1 In rng1
                                    cell1.Value = "'" & Cells(cell1.Row, _
                                        intMATFEED).Value
                                Next cell1
                            End If
                            
                            Set rng = rng.Offset(, 1)
                            rng.Value = "DB_PERIOD"
                            Set rng1 = Range(.Cells(2, rng.Column), _
                                .Cells(lngROW, rng.Column))
                            For Each cell1 In rng1
                                cell1.Value = strMON & strYEAR
                            Next cell1
                    
                        Case "IATS"
                            For Each cell In rng
                                Select Case cell.Value
                                    Case "c_AMOUNT_NORMALIZED"
                                        intAMT = cell.Column
                                    Case "APN_LMT"
                                        intLMT = cell.Column
                                    Case "c_MATCHED_DCAS"
                                        intMATDCAS = cell.Column
                                    Case "c_MATCHALL_IATS"
                                        intMATFEED = cell.Column
                                    End Select
                            Next cell
                            
                            If Not intAMT = 0 Then
                                Set rng = Cells(1, lngCOL + 1)
                                rng.Value = "DB_Amount"
                                Set rng1 = Range(.Cells(2, rng.Column), _
                                    .Cells(lngROW, rng.Column))
                            
                                For Each cell1 In rng1
                                    cell1.Value = Cells(cell1.Row, intAMT).Value
                                Next cell1
                            End If
                            
                            If Not intLMT = 0 Then
                                Set rng = rng.Offset(, 1)
                                rng.Value = "DB_Limit"
                                Set rng1 = Range(.Cells(2, rng.Column), _
                                    .Cells(lngROW, rng.Column))
                            
                                For Each cell1 In rng1
                                    cell1.Value = "'" & Cells(cell1.Row, intLMT).Value
                                Next cell1
                            End If
                            
                            If Not intMATFEED = 0 Then
                            Set rng = rng.Offset(, 1)
                                rng.Value = "DB_Match_FEED"
                                Set rng1 = Range(.Cells(2, rng.Column), _
                                    .Cells(lngROW, rng.Column))
                            
                                For Each cell1 In rng1
                                    cell1.Value = "'" & Cells(cell1.Row, intMATFEED).Value
                                Next cell1
                            End If
                            
                            Set rng = rng.Offset(, 1)
                            rng.Value = "DB_PERIOD"
                            Set rng1 = Range(.Cells(2, rng.Column), _
                                .Cells(lngROW, rng.Column))
                            For Each cell1 In rng1
                                cell1.Value = strMON & strYEAR
                            Next cell1
                    
                        Case "CAPS", "CAPS-W", "CAPSW"
                            For Each cell In rng
                                Select Case cell.Value
                                    Case "Trns_Amt"
                                        intAMT = cell.Column
                                    Case "LIMIT"
                                        intLMT = cell.Column
                                    Case "c_MATCHED_DCAS", "MATCHALL_DCAS"
                                        intMATDCAS = cell.Column
                                    Case "c_MATCHALL_CAPS", "MATCHALL_CAPS"
                                        intMATFEED = cell.Column
                                End Select
                            Next cell
                            
                            If Not intAMT = 0 Then
                                Set rng = Cells(1, lngCOL + 1)
                                rng.Value = "DB_Amount"
                                Set rng1 = Range(.Cells(2, rng.Column), _
                                    .Cells(lngROW, rng.Column))
                            
                                For Each cell1 In rng1
                                    cell1.Value = Cells(cell1.Row, intAMT).Value
                                Next cell1
                            End If
                            
                            If Not intLMT = 0 Then
                                Set rng = rng.Offset(, 1)
                                rng.Value = "DB_Limit"
                                Set rng1 = Range(.Cells(2, rng.Column), _
                                    .Cells(lngROW, rng.Column))
                            
                                For Each cell1 In rng1
                                    cell1.Value = "'" & Cells(cell1.Row, _
                                        intLMT).Value
                                Next cell1
                            End If
                            
                            If Not intMATFEED = 0 Then
                                Set rng = rng.Offset(, 1)
                                rng.Value = "DB_Match_FEED"
                                Set rng1 = Range(.Cells(2, rng.Column), _
                                    .Cells(lngROW, rng.Column))
                            
                                For Each cell1 In rng1
                                    cell1.Value = "'" & Cells(cell1.Row, _
                                        intMATFEED).Value
                                Next cell1
                            End If
                            
                            Set rng = rng.Offset(, 1)
                            rng.Value = "DB_PERIOD"
                            Set rng1 = Range(.Cells(2, rng.Column), _
                                .Cells(lngROW, rng.Column))
                            For Each cell1 In rng1
                                cell1.Value = strMON & strYEAR
                            Next cell1
                    
                        Case "ONEPAY", "One Pay", "ONE PAY", "OnePay"
                            For Each cell In rng
                                Select Case cell.Value
                                    Case "Amount"
                                        intAMT = cell.Column
                                    Case "SUBHD"
                                        intLMT = cell.Column
                                    Case "c_MATCHED_DCAS"
                                        intMATDCAS = cell.Column
                                    Case "c_MATCHALL_ONEPAY"
                                        intMATFEED = cell.Column
                                End Select
                            Next cell
                            If Not intAMT = 0 Then
                                Set rng = Cells(1, lngCOL + 1)
                                rng.Value = "DB_Amount"
                                Set rng1 = Range(.Cells(2, rng.Column), _
                                    .Cells(lngROW, rng.Column))
    
                                For Each cell1 In rng1
                                    cell1.Value = Cells(cell1.Row, intAMT).Value
                                Next cell1
                            End If
                            
                            If Not intLMT = 0 Then
                                Set rng = rng.Offset(, 1)
                                rng.Value = "DB_Limit"
                                Set rng1 = Range(.Cells(2, rng.Column), _
                                    .Cells(lngROW, rng.Column))
                            
                                For Each cell1 In rng1
                                    cell1.Value = "'" & Cells(cell1.Row, _
                                        intLMT).Value
                                Next cell1
                            End If
                            
                            If Not intMATFEED = 0 Then
                                Set rng = rng.Offset(, 1)
                                rng.Value = "DB_Match_FEED"
                                Set rng1 = Range(.Cells(2, rng.Column), _
                                    .Cells(lngROW, rng.Column))
                                
                                For Each cell1 In rng1
                                    cell1.Value = "'" & Cells(cell1.Row, _
                                        intMATFEED).Value
                                Next cell1
                            End If
                            
                            Set rng = rng.Offset(, 1)
                            rng.Value = "DB_PERIOD"
                            Set rng1 = Range(.Cells(2, rng.Column), _
                                .Cells(lngROW, rng.Column))
                            For Each cell1 In rng1
                                cell1.Value = "'" & strMON & strYEAR
                            Next cell1
                    End Select
                End Select
            End With
        
            Call SortLTable(ws)
            
            wbIMPORT.SaveAs FileName:=strFULLPATH
            
            lngCOL = Cells(1, .Columns.Count).End(xlToLeft).Column
            lngROW = Range("A" & .Rows.Count).End(xlUp).Row
            Set rngHEAD = Range(.Cells(1, 1), .Cells(lngROW, lngCOL))
            
            
            
            strTBLNAME = "TEMP_TBL_" & ws.Name & "_" & strMON & "_" & strYEAR
        
            DoCmd.TransferSpreadsheet acImport, _
            acSpreadsheetTypeExcel12, strTBLNAME, _
            strFULLPATH, _
            True, _
            ws.Name & "!"
            
            Call AURD_APPEND_ME(ws, db, strTBLNAME)
            
            DoCmd.DeleteObject acTable, strTBLNAME


        End If
    End If
Next ws

'MsgBox "all done"
Set ws = Nothing
wbIMPORT.Close False

Kill (strFULLPATH)
Set wbIMPORT = Nothing
With appEXCEL
    .DisplayAlerts = True
    .Visible = False
    .ScreenUpdating = True
End With
appEXCEL.Quit
Set appEXCEL = Nothing
Set db = Nothing

End Sub

I think that it is not releasing excel properly after close. PLEASE note this is code in progress so I have not added a graceful exit nor error handling as yet.

Thanks,

Rich
 

Excel Facts

Excel Joke
Why can't spreadsheets drive cars? They crash too often!
Sort by date Sort by votes
Put a break point on the code here, and see if it creates the new application to test that theory.
Code: 
[SIZE=5][B].[/B][/SIZE]If appEXCEL Is Nothing Then     
 Set appEXCEL = New Excel.Application 
End If
IF I hit the reset button in the VBE and start over it runs fine.
Click to expand...
If you have to do that, it sounds like the code has not terminated. Try stepping through the whole process and watch for something that is left hanging or affecting your last row of the first worksheet, or a variable that you're using to reference that.

Also, I would not set to False at the end or exit just in case it affects your next instance of Excel. In fact, if I set it to false at the beginning (which you did not) I set it to True at the end just in case. You should get the error routine in soon and handle the application properties and reclaim memory variables, because it can stop running after it affects the Excel instance. Maybe not an issue in your case, but if you decide to make Excel invisible, you'll have to kill it with Task Manager if the code craps out early and leaves it in that state. The rest isn't criticism, just suggestions:
Select Case strMONTH
Case "January"
This sort of repetition begs for a custom function like GetDateVars (Me.cmBoMonth.Column(1)) where the called function code returns the values. There are several ways to get multiple values from a function, better to provide a link rather than elaborate here Microsoft Access tips: Returning more than one value from a function
The Public Type option looks good to me for your needs.

strYEAR = strYEAR
Not only does it not need to be repeated (it can be set once outside of and after the Select block), it would have no effect regardless since it was already declared to be Forms![FRM_IMPORT]![TXT_Year]
 
Upvote 0
Good point on the strYEAR I will remove that.

I commented out the if statement to see if that killed the bug, but I am still getting error.

actual error is:

Runtime error '1004':
Method 'Range' of object '_global' failed

This happens here

Code: 
Set wbIMPORT = appEXCEL.WORKBOOKS.Open(strFULLPATH)
strFNAME1 = strFNAME1 & "Upload"
strFULLPATH = strFPATH & strFNAME1 & strFNAMEEXT
wbIMPORT.SaveAs FileName:=strFULLPATH
wbIMPORT.Activate
For Each ws In wbIMPORT.Worksheets
varI = 0
If Not Left(ws.Name, 6) = "Acerno" Then
    ws.Select
    With ws
        lngROW = Range("A" & .Rows.Count).End(xlUp).Row   "****** this triggers the run-time error********
        If lngROW = 1 Or Left(Range("A" & lngROW).Value, 2) = "NO" Then
            varI = 1
        End If
    End With

I am looking at the link for returning more than one variable from a function now

thanks

rich
 
Upvote 0
I suspect lngROW = Range("A" & .Rows.Count).End(xlUp).Row should be
lngROW = .Range("A" & .Rows.Count).End(xlUp).Row
just like you used .Rows
You've invoked the ws object (With ws) thus you have to precede all of its properties or methods correctly.
If that fixes it, thank the fact that you followed tips number 1 and 2!
 
Upvote 0
ok adding the "." before references to range objects has fixed that error, however, excel is still not quitting properly after each use. When I try to use the code with out resetting VBE I get a new error

Run-time error '3011':

The Microsoft Access database engine could not find the object 'IMPORT_NAME'. Make sure the object exists and that you spell its name and path name correctly. If 'IMPORT_NAME' is not a local object, check your network connection or contact....blah blah

the error occurs here:

Code: 
            With ws
                lngCOL = .Cells(1, .Columns.Count).End(xlToLeft).Column
                lngROW = .Range("A" & .Rows.Count).End(xlUp).Row
                Set rnghead = .Range(.Cells(1, 1), .Cells(lngROW, lngCOL))
                

                wbIMPORT.Names.Add Name:="IMPORT_NAME", RefersTo:=rnghead
            End With
            strTBLNAME = "TEMP_TBL_" & ws.Name & "_" & strMON & "_" & strYEAR

            DoCmd.TransferSpreadsheet acImport, _
            acSpreadsheetTypeExcel12, strTBLNAME, strFULLPATH, _
            True, "IMPORT_NAME"    '*************************error occurs from this line of code***************
            
On Error Resume Next
            db.Execute "ALTER TABLE strtblname ALTER COLUMN SCLIN text"
On Error GoTo 0

note the docmd line works fine on the first run and fine if I re-set the VBE

Thanks,

Rich
 
Upvote 0
Glad we're progressing! Not sure why it works first, then only after a reset. I suspect that has nothing to do with the current error, so even if we solve 3011, I would not be surprised to find that issue still exists.
excel is still not quitting properly after each use
Click to expand...
Without stepping through or having an error handling routine, I'm not as confident in this as you are. I suggested you put a break on that section and check if there was an active instance of Excel on the second and subsequent tries, but you commented it out instead. Not the same thing. Perhaps also this is a good reason for getting some error handling in place - it might flag a problem you're not seeing.

In the meantime, 3011 suggests your range name is not being resolved.
1) check the spelling
2) check the scope - I think it has to be defined at the spreadsheet level, not the workbook.
 
Upvote 0
ok finally got the code to run more than once without re-setting the vbe.

At the beginning of the code I put in two lines - see below

Code: 
excel.Application.Visible = True
excel.Application.Quit

The over all code is slow, so needs some work to make it more efficient, but it works.
 
Upvote 0
Good that you are making progress, but I wonder if the cause was that you're holding this open
wbIMPORT.Close False
 
Upvote 0
Upvote 0
Sorry, I had to refresh my memory for the syntax for closing a file. At first, I thought the statement was holding memory allocated for the variable.
I will look at your other link, but if I don't have much to offer, I'll pm you about it just to let you know I did.
 
Upvote 0
You must log in or register to reply here.

Similar threads

A
  • Question Question
Efficiently Importing Large Records to MS - Access
Replies
8
Views
1K
jackd
J
T
  • Question Question
VBA compare values on different sheets.
Replies
5
Views
580
rlv01
R
S
  • Question Question
ACCESS, VBA: Fetch data from sql server and paste it into local table.
Replies
3
Views
2K
Micron
M
N
  • Question Question
Finding the differences then copy and paste code to a new sheet
Replies
1
Views
583
myall_blues
myall_blues
tjdrake
  • Solved
Multi-User Access DB Table
Replies
3
Views
1K
Micron
M

Forum statistics

Threads
1,223,277
Messages
6,171,148
Members
452,382
Latest member
RonChand

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