A
Ashish Kanoongo
Please review my following code, specially line which contains "ERROR COMES HERE". This function comes first time successfully, but next time it give me error "Method 'Cells' of object '_Global' failed ". If I close the application and run the application it will again run successfully. Is this problem of activesheet or something else?
Please let me know how should I handle this?
*----------------------- Function
Dim ExcelApp As New Excel.Application
Dim ExcelSht As New Excel.Worksheet
Dim ExcelWkb As New Excel.Workbook
Set ExcelApp = CreateObject("Excel.Application")
' Uncomment this line to make Excel visible.
ExcelApp.Visible = True
Set ExcelWkb = ExcelApp.Workbooks.Add
Set ExcelSht = ExcelWkb.Worksheets(1)
ExcelSht.Visible = xlSheetVisible
ExcelSht.PageSetup.PrintGridlines = True
ExcelSht.PageSetup.Orientation = xlLandscape
ExcelSht.PageSetup.CenterHeader = "Fee Distrubution" & vbCrLf & "November 2000"
rsExcel.ActiveConnection = CurrentProject.Connection
rsExcel.CursorLocation = adUseClient
rsExcel.Open "SELECT * FROM tmpExcel"
' Make the column headers.
For i = 0 To rsExcel.Fields.Count - 2
ExcelSht.Cells(1, i + 1) = rsExcel.Fields(i).name
Next i
' ----> For Adbance BIlling
If rsExcel.state = 1 Then
rsExcel.Close
End If
rsExcel.ActiveConnection = CurrentProject.Connection
rsExcel.CursorLocation = adUseClient
rsExcel.Open "SELECT * FROM tmpExcel where AIPFlag = -1"
' Get data from the database and insert
' it into the spreadsheet.
If Not rsExcel.EOF Then
mycount = rsExcel.RecordCount
End If
'****************************************************
'==> Asset Mgmt. Billing - Advance
'****************************************************
ExcelSht.Cells(2, 1) = "Asset Mgmt. Billing - Advance"
ExcelSht.Rows(2).Font.Bold = True
row = 4
Do Until rsExcel.EOF
For i = 0 To rsExcel.Fields.Count - 2
ExcelSht.Cells(row, i + 1) = rsExcel.Fields(i).Value
Next i
'*********** ERROR COMES HERE ***********************************************
ExcelSht.Range(Cells(row, 7), Cells(row, i - 1)).Select
Cells(row, i).Formula = "=sum(" & Selection.AddressLocal & ")"
'*********** ERROR COMES HERE ***********************************************
row = row + 1
rsExcel.MoveNext
Loop
row = row + 1
If rsExcel.EOF Then
For i = 2 To rsExcel.Fields.Count - 2
ExcelSht.Cells(row, i + 1) = 0
Next i
'*********** ERROR COMES HERE ***********************************************
ExcelSht.Range(Cells(row, 7), Cells(row, i - 1)).Select
Cells(row, i) = "=sum(" & Selection.AddressLocal & ")"
'*****************************************************************************
row = row + 1
End If
' Total Billed Asset Header
ExcelSht.Cells(row + 1, 1) = "TOTALS-ADVANCE BILLED ASSETS"
ExcelSht.Cells(row + 1, 1).Font.Bold = True
'*********** ERROR COMES HERE ***********************************************
' Sum for Billed Asset
ExcelSht.Range(Cells(4, 3), Cells(row, 3)).Select
Cells(row + 1, 3).Formula = "=sum(" & Selection.AddressLocal & ")"
'*********** ERROR COMES HERE ***********************************************
row = row + 2
' Total Billed Asset Header
ExcelSht.Cells(row + 1, 1) = "TOTALS-ADVANCE BILLED"
ExcelSht.Cells(row + 1, 1).Font.Bold = True
' Sum for Advance Billing
'*********** ERROR COMES HERE ***********************************************
ExcelSht.Range(Cells(4, 4), Cells(row - 2, 4)).Select
Cells(row + 1, 4).Formula = "=sum(" & Selection.AddressLocal & ")"
'*********** ERROR COMES HERE ***********************************************
cellAdvBill = Cells(row + 1, 4).Address
' Sum for Capes Distrubution
'*********** ERROR COMES HERE ***********************************************
ExcelSht.Range(Cells(4, 5), Cells(row - 2, 5)).Select
Cells(row + 1, 5).Formula = "=sum(" & Selection.AddressLocal & ")"
'*********** ERROR COMES HERE ***********************************************
cellAdvCapDist = Cells(row + 1, 5).Address
' Sum for Amount To Distrubite
'*********** ERROR COMES HERE ***********************************************
ExcelSht.Range(Cells(4, 6), Cells(row - 2, 6)).Select
Cells(row + 1, 6).Formula = "=sum(" & Selection.AddressLocal & ")"
'*********** ERROR COMES HERE ***********************************************
cellAdvAmtDist = Cells(row + 1, 6).Address
ReDim arrTotalArr(PMCounter + 7)
For j = 7 To i
'*********** ERROR COMES HERE ***********************************************
ExcelSht.Range(Cells(4, j), Cells(row - 2, j)).Select
Cells(row + 1, j).Formula = "=sum(" & Selection.AddressLocal & ")"
'*********** ERROR COMES HERE ***********************************************
If Cells(row + 1, j).Address <> "" Then
arrTotalArr(j) = Cells(row + 1, j).Address
End If
Next j
' ----> For Arrear BIlling
If rsExcel.state = 1 Then
rsExcel.Close
End If
rsExcel.ActiveConnection = CurrentProject.Connection
rsExcel.CursorLocation = adUseClient
rsExcel.Open "SELECT * FROM tmpExcel where AIPFlag = 0"
' Get data from the database and insert
' it into the spreadsheet.
row = row + 4
'*----- End of Asset Mgmt. Billing - Advance
'****************************************************
'==> Asset Mgmt. Billing - Arrears
'****************************************************
ExcelSht.Cells(row, 1) = "Asset Mgmt. Billing - Arrears"
ExcelSht.Rows(row).Font.Bold = True
row = row + 2
newrow = row
Do Until rsExcel.EOF
For i = 0 To rsExcel.Fields.Count - 2
ExcelSht.Cells(row, i + 1) = rsExcel.Fields(i).Value
Next i
ExcelSht.Range(Cells(row, 7), Cells(row, i - 1)).Select
Cells(row, i).Formula = "=sum(" & Selection.AddressLocal & ")"
row = row + 1
rsExcel.MoveNext
Loop
row = row + 2
' Total Arrear Asset Header
ExcelSht.Cells(row + 1, 1) = "TOTALS-ARREARS-BILLING"
ExcelSht.Cells(row + 1, 1).Font.Bold = True
'*********** ERROR COMES HERE ***********************************************
' Sum for Advance Billing
ExcelSht.Range(Cells(newrow, 4), Cells(row - 1, 4)).Select
Cells(row + 1, 4).Formula = "=sum(" & Selection.AddressLocal & ")"
cellArrBill = Cells(row + 1, 4).Address
'*****************************************************************************
'*********** ERROR COMES HERE ***********************************************
' Sum for Capes Distrubution
ExcelSht.Range(Cells(newrow, 5), Cells(row - 1, 5)).Select
Cells(row + 1, 5).Formula = "=sum(" & Selection.AddressLocal & ")"
cellArrCapDist = Cells(row + 1, 5).Address
'*****************************************************************************
'*********** ERROR COMES HERE ***********************************************
' Sum for Amount To Distrubite
ExcelSht.Range(Cells(newrow, 6), Cells(row - 1, 6)).Select
Cells(row + 1, 6).Formula = "=sum(" & Selection.AddressLocal & ")"
cellArrAmtDist = Cells(row + 1, 6).Address
'*****************************************************************************
ReDim arrTotalAdv(PMCounter + 7)
For j = 7 To i
'*********** ERROR COMES HERE ***********************************************
ExcelSht.Range(Cells(newrow, j), Cells(row - 1, j)).Select
Cells(row + 1, j).Formula = "=sum(" & Selection.AddressLocal & ")"
'*****************************************************************************
If Cells(row + 1, j).Address <> "" Then
arrTotalAdv(j) = Cells(row + 1, j).Address
End If
Next j
If rsExcel.state = 1 Then
rsExcel.Close
End If
rsExcel.ActiveConnection = CurrentProject.Connection
rsExcel.CursorLocation = adUseClient
rsExcel.Open "SELECT * FROM tmpExcel"
' Get data from the database and insert
' it into the spreadsheet.
row = row + 4
'*----- End of Asset Mgmt. Billing - Arrears
' Make the header bold.
ExcelSht.Rows(1).Font.Bold = True
' Make the columns autofit the data.
ExcelSht.Range(ExcelSht.Cells(1, 1), _
ExcelSht.Cells(row, i)).Select
ExcelApp.Selection.Columns.AutoFit
' Freeze the header row so it doesn't scroll.
ExcelSht.Rows(2).Select
ExcelApp.ActiveWindow.FreezePanes = True
' Select the first cell.
ExcelSht.Cells(1, 1).Select
' Comment the Close and Quit lines to keep
' Excel running so you can see it.
row = row + 2
row = 0
Set ExcelSht = Nothing
' Close the work book saving changes.
ExcelWkb.Close True
' ExcelApp.ActiveWorkbook.Close False
ExcelApp.Quit
Set ExcelApp = Nothing
End Sub
Please let me know how should I handle this?
*----------------------- Function
Dim ExcelApp As New Excel.Application
Dim ExcelSht As New Excel.Worksheet
Dim ExcelWkb As New Excel.Workbook
Set ExcelApp = CreateObject("Excel.Application")
' Uncomment this line to make Excel visible.
ExcelApp.Visible = True
Set ExcelWkb = ExcelApp.Workbooks.Add
Set ExcelSht = ExcelWkb.Worksheets(1)
ExcelSht.Visible = xlSheetVisible
ExcelSht.PageSetup.PrintGridlines = True
ExcelSht.PageSetup.Orientation = xlLandscape
ExcelSht.PageSetup.CenterHeader = "Fee Distrubution" & vbCrLf & "November 2000"
rsExcel.ActiveConnection = CurrentProject.Connection
rsExcel.CursorLocation = adUseClient
rsExcel.Open "SELECT * FROM tmpExcel"
' Make the column headers.
For i = 0 To rsExcel.Fields.Count - 2
ExcelSht.Cells(1, i + 1) = rsExcel.Fields(i).name
Next i
' ----> For Adbance BIlling
If rsExcel.state = 1 Then
rsExcel.Close
End If
rsExcel.ActiveConnection = CurrentProject.Connection
rsExcel.CursorLocation = adUseClient
rsExcel.Open "SELECT * FROM tmpExcel where AIPFlag = -1"
' Get data from the database and insert
' it into the spreadsheet.
If Not rsExcel.EOF Then
mycount = rsExcel.RecordCount
End If
'****************************************************
'==> Asset Mgmt. Billing - Advance
'****************************************************
ExcelSht.Cells(2, 1) = "Asset Mgmt. Billing - Advance"
ExcelSht.Rows(2).Font.Bold = True
row = 4
Do Until rsExcel.EOF
For i = 0 To rsExcel.Fields.Count - 2
ExcelSht.Cells(row, i + 1) = rsExcel.Fields(i).Value
Next i
'*********** ERROR COMES HERE ***********************************************
ExcelSht.Range(Cells(row, 7), Cells(row, i - 1)).Select
Cells(row, i).Formula = "=sum(" & Selection.AddressLocal & ")"
'*********** ERROR COMES HERE ***********************************************
row = row + 1
rsExcel.MoveNext
Loop
row = row + 1
If rsExcel.EOF Then
For i = 2 To rsExcel.Fields.Count - 2
ExcelSht.Cells(row, i + 1) = 0
Next i
'*********** ERROR COMES HERE ***********************************************
ExcelSht.Range(Cells(row, 7), Cells(row, i - 1)).Select
Cells(row, i) = "=sum(" & Selection.AddressLocal & ")"
'*****************************************************************************
row = row + 1
End If
' Total Billed Asset Header
ExcelSht.Cells(row + 1, 1) = "TOTALS-ADVANCE BILLED ASSETS"
ExcelSht.Cells(row + 1, 1).Font.Bold = True
'*********** ERROR COMES HERE ***********************************************
' Sum for Billed Asset
ExcelSht.Range(Cells(4, 3), Cells(row, 3)).Select
Cells(row + 1, 3).Formula = "=sum(" & Selection.AddressLocal & ")"
'*********** ERROR COMES HERE ***********************************************
row = row + 2
' Total Billed Asset Header
ExcelSht.Cells(row + 1, 1) = "TOTALS-ADVANCE BILLED"
ExcelSht.Cells(row + 1, 1).Font.Bold = True
' Sum for Advance Billing
'*********** ERROR COMES HERE ***********************************************
ExcelSht.Range(Cells(4, 4), Cells(row - 2, 4)).Select
Cells(row + 1, 4).Formula = "=sum(" & Selection.AddressLocal & ")"
'*********** ERROR COMES HERE ***********************************************
cellAdvBill = Cells(row + 1, 4).Address
' Sum for Capes Distrubution
'*********** ERROR COMES HERE ***********************************************
ExcelSht.Range(Cells(4, 5), Cells(row - 2, 5)).Select
Cells(row + 1, 5).Formula = "=sum(" & Selection.AddressLocal & ")"
'*********** ERROR COMES HERE ***********************************************
cellAdvCapDist = Cells(row + 1, 5).Address
' Sum for Amount To Distrubite
'*********** ERROR COMES HERE ***********************************************
ExcelSht.Range(Cells(4, 6), Cells(row - 2, 6)).Select
Cells(row + 1, 6).Formula = "=sum(" & Selection.AddressLocal & ")"
'*********** ERROR COMES HERE ***********************************************
cellAdvAmtDist = Cells(row + 1, 6).Address
ReDim arrTotalArr(PMCounter + 7)
For j = 7 To i
'*********** ERROR COMES HERE ***********************************************
ExcelSht.Range(Cells(4, j), Cells(row - 2, j)).Select
Cells(row + 1, j).Formula = "=sum(" & Selection.AddressLocal & ")"
'*********** ERROR COMES HERE ***********************************************
If Cells(row + 1, j).Address <> "" Then
arrTotalArr(j) = Cells(row + 1, j).Address
End If
Next j
' ----> For Arrear BIlling
If rsExcel.state = 1 Then
rsExcel.Close
End If
rsExcel.ActiveConnection = CurrentProject.Connection
rsExcel.CursorLocation = adUseClient
rsExcel.Open "SELECT * FROM tmpExcel where AIPFlag = 0"
' Get data from the database and insert
' it into the spreadsheet.
row = row + 4
'*----- End of Asset Mgmt. Billing - Advance
'****************************************************
'==> Asset Mgmt. Billing - Arrears
'****************************************************
ExcelSht.Cells(row, 1) = "Asset Mgmt. Billing - Arrears"
ExcelSht.Rows(row).Font.Bold = True
row = row + 2
newrow = row
Do Until rsExcel.EOF
For i = 0 To rsExcel.Fields.Count - 2
ExcelSht.Cells(row, i + 1) = rsExcel.Fields(i).Value
Next i
ExcelSht.Range(Cells(row, 7), Cells(row, i - 1)).Select
Cells(row, i).Formula = "=sum(" & Selection.AddressLocal & ")"
row = row + 1
rsExcel.MoveNext
Loop
row = row + 2
' Total Arrear Asset Header
ExcelSht.Cells(row + 1, 1) = "TOTALS-ARREARS-BILLING"
ExcelSht.Cells(row + 1, 1).Font.Bold = True
'*********** ERROR COMES HERE ***********************************************
' Sum for Advance Billing
ExcelSht.Range(Cells(newrow, 4), Cells(row - 1, 4)).Select
Cells(row + 1, 4).Formula = "=sum(" & Selection.AddressLocal & ")"
cellArrBill = Cells(row + 1, 4).Address
'*****************************************************************************
'*********** ERROR COMES HERE ***********************************************
' Sum for Capes Distrubution
ExcelSht.Range(Cells(newrow, 5), Cells(row - 1, 5)).Select
Cells(row + 1, 5).Formula = "=sum(" & Selection.AddressLocal & ")"
cellArrCapDist = Cells(row + 1, 5).Address
'*****************************************************************************
'*********** ERROR COMES HERE ***********************************************
' Sum for Amount To Distrubite
ExcelSht.Range(Cells(newrow, 6), Cells(row - 1, 6)).Select
Cells(row + 1, 6).Formula = "=sum(" & Selection.AddressLocal & ")"
cellArrAmtDist = Cells(row + 1, 6).Address
'*****************************************************************************
ReDim arrTotalAdv(PMCounter + 7)
For j = 7 To i
'*********** ERROR COMES HERE ***********************************************
ExcelSht.Range(Cells(newrow, j), Cells(row - 1, j)).Select
Cells(row + 1, j).Formula = "=sum(" & Selection.AddressLocal & ")"
'*****************************************************************************
If Cells(row + 1, j).Address <> "" Then
arrTotalAdv(j) = Cells(row + 1, j).Address
End If
Next j
If rsExcel.state = 1 Then
rsExcel.Close
End If
rsExcel.ActiveConnection = CurrentProject.Connection
rsExcel.CursorLocation = adUseClient
rsExcel.Open "SELECT * FROM tmpExcel"
' Get data from the database and insert
' it into the spreadsheet.
row = row + 4
'*----- End of Asset Mgmt. Billing - Arrears
' Make the header bold.
ExcelSht.Rows(1).Font.Bold = True
' Make the columns autofit the data.
ExcelSht.Range(ExcelSht.Cells(1, 1), _
ExcelSht.Cells(row, i)).Select
ExcelApp.Selection.Columns.AutoFit
' Freeze the header row so it doesn't scroll.
ExcelSht.Rows(2).Select
ExcelApp.ActiveWindow.FreezePanes = True
' Select the first cell.
ExcelSht.Cells(1, 1).Select
' Comment the Close and Quit lines to keep
' Excel running so you can see it.
row = row + 2
row = 0
Set ExcelSht = Nothing
' Close the work book saving changes.
ExcelWkb.Close True
' ExcelApp.ActiveWorkbook.Close False
ExcelApp.Quit
Set ExcelApp = Nothing
End Sub