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