Excel vba program giving error when running second time...

[kavya]

excel program when run second time from MS Access - fails giving object failed or method global row failed etc different error each time while stepping through code...
I think the cause is because of instance of excel is still seen in task manager process section.

Not able to figure out - what is wrong letting the excel still hang and not completely close out.

here is the code.

********
Public Sub Format_Report(whichquery As String)


Dim oapp As Object
Dim xlWkb As Object
Dim xlWks As Object

Dim iLastRow As Integer
Dim NumRowSearched As Integer



Set oapp = CreateObject("Excel.Application")
Set xlWkb = oapp.Workbooks.Open("C:\temp\TReport.xls")
Set xlWks = xlWkb.Worksheets("Sheet1")

Dim rval As String, I As Long

'insert rows in between and color fill
xlWkb.Worksheets("Sheet1").Select



rval = xlWks.Cells(1, 1): I = 2
Do Until Trim(xlWks.Cells(I, 1) & "") = ""
If xlWks.Cells(I, 1) <> rval Then
rval = xlWks.Cells(I, 1)

xlWks.Rows(I).Insert Shift:=xlDown
'color the row before

I = I + 1
'MsgBox i
xlWks.Rows(I - 1).EntireRow.Interior.ColorIndex = 17
End If
I = I + 1

Loop

oapp.Visible = True

iLastRow = xlWks.Cells(65536, 1).End(-4162).Row

'find the row that reads G Total
Dim sRow As Variant

sRow = oapp.WorksheetFunction.Match("G Total", xlWkb.Worksheets("sheet1").range("A1:A60"), 0)

If IsError(sRow) Then
'not found
err.Clear
End If
On Error GoTo 0


'Moves a row up or down in the worksheet
Dim rg As range

Dim myData As Variant, temp As Variant
Dim nRowSource As Long, nRowDestination As Long
nRowSource = sRow
nRowDestination = iLastRow
Set rg = xlWks.Rows(sRow)
xlWks.Rows(nRowDestination + 2).Insert
rg.Copy
xlWks.Rows(nRowDestination).PasteSpecial
rg.Delete

Dim Last As Long
Last = xlWkb.Worksheets("Sheet1").Cells.Find("*", SearchOrder:=xlByColumns, _
LookIn:=xlValues, SearchDirection:=xlPrevious).Column
'MsgBox Last


Dim X As Integer

For X = 1 To xlWkb.Worksheets("Sheet1").UsedRange.Columns.count
xlWkb.Worksheets("Sheet1").Columns(X).EntireColumn.AutoFit
Next X

oapp.ActiveWorkbook.RefreshAll

'xlWkb.Worksheets("Sheet1").AutoFit


With xlWks.Rows(1)
' .Font.Bold = True
.Interior.ColorIndex = 6

End With

'to avoid confusion variables are defined here place where they are being used.
Dim row_min As Integer
Dim row_max As Integer
Dim col_min As Integer
Dim col_max As Integer

' Select the used range.

xlWkb.Worksheets("Sheet1").UsedRange.Select

' Display the range's rows and columns.
row_min = xlWkb.Worksheets("Sheet1").UsedRange.Row
row_max = row_min + xlWkb.Worksheets("Sheet1").UsedRange.Rows.count - 1
col_min = xlWkb.Worksheets("Sheet1").UsedRange.Column
col_max = col_min + xlWkb.Worksheets("Sheet1").UsedRange.Columns.count - 1

' MsgBox row_min
'MsgBox row_max
'MsgBox col_min
'MsgBox col_max



Dim maxCol_name As String
Dim minCol_name As String

maxCol_name = get_columnName(col_max)
minCol_name = get_columnName(col_min)

'xlWkb.Worksheets("Sheet1").range("A1:1").EntireRow.Insert

Dim lastcell As range

'format as needed the margins, orientation, header, fit to page etc.
xlWkb.Worksheets("Sheet1").PageSetup.LeftMargin = oapp.InchesToPoints(0.1)

xlWkb.Worksheets("Sheet1").PageSetup.RightMargin = oapp.InchesToPoints(0.1)

xlWkb.Worksheets("Sheet1").PageSetup.Orientation = xlLandscape

xlWkb.Worksheets("sheet1").Cells.Font.Name = "Times New Roman"


If whichquery = "Combined" Then
'case disposition reports few columns, no review categories...hence column width may be increased
xlWkb.Worksheets("sheet1").range("D1" & ":" & maxCol_name & 1).ColumnWidth = 9.3
Else
xlWkb.Worksheets("sheet1").range("D1" & ":" & maxCol_name & 1).ColumnWidth = 5.29
End If


xlWkb.Worksheets("sheet1").Cells.Font.Size = 12
xlWkb.Worksheets("Sheet1").range(minCol_name & 1 & ":" & maxCol_name & 1).WrapText = True
xlWkb.Worksheets("Sheet1").range(minCol_name & ":" & maxCol_name).HorizontalAlignment = xlHAlignLeft
xlWkb.Worksheets("sheet1").PageSetup.FitToPagesWide = 1
xlWkb.Worksheets("sheet1").PageSetup.FitToPagesTall = 1
xlWkb.Worksheets("sheet1").PageSetup.Zoom = False
xlWkb.Worksheets("Sheet1").PageSetup.PrintArea = xlWkb.Worksheets("sheet1").UsedRange.address
xlWkb.Worksheets("Sheet1").PageSetup.PrintGridlines = True


If whichquery = "Combined" Then
Call DeleteColumns
Call Worksheet_Change
End If

'name the application according to the report name etc
Dim strtype As String
Dim strfile As String
strtype = Me!ReqType

If whichquery = "QY_ActiveToday_Final" Then
strfile = "c:\temp" & "\" & strtype & "_ActiveCases" & ".xls"
xlWkb.Worksheets("Sheet1").PageSetup.LeftHeader = strtype & " Case Load as of Today"

ElseIf whichquery = "Del_final" Then
strfile = "c:\temp" & "\" & strtype & "_DelinquentCases" & ".xls"
xlWkb.Worksheets("Sheet1").PageSetup.LeftHeader = strtype & " Delinquent Case Load as of Today"
ElseIf whichquery = "Combined" Then
strfile = "c:\temp" & "\" & strtype & "_Case Disposition" & ".xls"
xlWkb.Worksheets("Sheet1").PageSetup.LeftHeader = strtype & " Case Disposition Report"

End If

'chk if file exists
'MsgBox strfile
'save a copy of report in c:\temp
If FileExist(strfile) = True Then
Kill (strfile)
End If
ActiveWorkbook.SaveAs filename:=strfile
ActiveWorkbook.Close False


Set xlWkb = Nothing
Set xlWks = Nothing
Set oapp = Nothing


MsgBox "Done - Reports are saved in C:\Temp", vbOKOnly




End Sub

**************

Functions called from the sub above

Public Function get_columnName(colNo As Integer)
If colNo > 26 Then
get_columnName = Chr(Int((colNo - 1) / 26) + 64) & Chr(((colNo - 1) Mod 26) + 65)
Else
get_columnName = Chr(colNo + 64)
End If
End Function

'delete some unwanted columns from the sheet
Sub DeleteColumns()
Dim cell As range, DeleteRange As range
For Each cell In Intersect(ActiveSheet.Rows(1), ActiveSheet.UsedRange)
If cell Like "tblOngoing*" Or cell Like "tblActive*" Or cell = "New" Or cell = "Active" Or cell = "Ongoing" Then
If DeleteRange Is Nothing Then
Set DeleteRange = cell.EntireColumn
Else
Set DeleteRange = Union(DeleteRange, cell.EntireColumn)
End If
End If
Next
If Not DeleteRange Is Nothing Then DeleteRange.Delete
End Sub

Private Sub Worksheet_Change()
Worksheets("Sheet1").Cells(1, "A").Value = "Supervisor"
Worksheets("Sheet1").Cells(1, "B").Value = "Case Mgr"
End Sub

 

[SkipVought]

Hi,

This code would probably get more Excel-VBA expert attntion in forum707.

Some thoughts, since you cannot identify a statement, just something about Method global row.

I would declare ANY variable that references row as LONG rather than Integer, as rows exceed 32,767.

Somthing else that bothered me -- why are you inserting empty rows? That REALLY makes working with your data difficult, like blindfolding yourself, one hand behind your back and hopping on one foot.

Skip,
[sub]
Just traded in my old subtlety...
for a NUANCE![/sub]

 

[StarPassing]

You are not closing the instance of excel.

Use: oapp.quit

 

[Golom]

You may also check for unqualified references as explained in this article.

 

[kavya]

I could Isolate the cause of the problem when executing the subprocedure below.

The function of the procedure is to delete specific columns based on the cell contents in first row. As the column number may be different each time, it has to look at cell content instead. I got this somewhere in the web forums. I need help either to correct the object reference or acheive the same with other similar code to do the job. Thanks

'delete some unwanted columns from the sheet
Sub DeleteColumns()
Dim cell As range, DeleteRange As range
For Each cell In Intersect(ActiveSheet.Rows(1), ActiveSheet.UsedRange)
If cell Like "tblOngoing*" Or cell Like "tblActive*" Or cell = "New" Or cell = "Active" Or cell = "Ongoing" Then
If DeleteRange Is Nothing Then
Set DeleteRange = cell.EntireColumn
Else
Set DeleteRange = Union(DeleteRange, cell.EntireColumn)
End If
End If
Next
If Not DeleteRange Is Nothing Then DeleteRange.Delete
End Sub

 

[SkipVought]

Problem is with your method that the loop reference gets DESTROYED when you delete the column.

I choose to avoid using INSERT & DELETE as much as possible.

But if you need to delete, the loop from the bottom up or right to left, using a counter/pointer.

Sub DeleteColumns()
    Dim iCol as integer
    For iCol = ActiveSheet.UsedRange.columns.count to 1
        If cells(1, icol) Like "tblOngoing*" Or cell Like "tblActive*" Or cell = "New" Or cell = "Active" Or cell = "Ongoing" Then
            cells(1, icol).entirecolumn.delete

Skip,
[sub]
Just traded in my old subtlety...
for a NUANCE![/sub]

 

[Golom]

This may be where the unqualified reference is happening. Instead of

For Each cell In Intersect(ActiveSheet.Rows(1), ActiveSheet.UsedRange)

Try

For Each cell In Intersect([red]xlWkb.[/red]ActiveSheet.Rows(1), [red]xlWkb.[/red]ActiveSheet.UsedRange)

You may need to pass the xlWkb object to the Sub so that you can use it.

 

[SkipVought]

Good catch Golom!

And I would add to mine, Step -1

    For iCol = ActiveSheet.UsedRange.columns.count to 1 Step - 1

Skip,
[sub]
Just traded in my old subtlety...
for a NUANCE![/sub]

 

[kavya]

I modified the code and tested without using another function call, entered the code directly in the procedure

'This is what I have
Dim iCol As Integer
For iCol = 1 To xlWkb.ActiveSheet.UsedRange.Columns.count
If xlWks.Cells(1, iCol) Like "tblOngoing*" Or xlWks.Cells(1, iCol) Like "tblActive*" Or xlWks.Cells(1, iCol) = "New" Or xlWks.Cells(1, iCol) = "Active" Or xlWks.Cells(1, iCol) = "Ongoing" Then
xlWks.Cells(1, iCol).EntireColumn.Delete
End If
Next

It does not do the job of deleting the columns - just runs throught the loop.

Any ideas..

 

[kavya]

Actually - I spoke too soon...
It deletes certain columns only, for some reasons - not deleting columns tblOngoing_casemgr and tblActive_casemgr
The above mentioned columns are covered in below line.

'xlWks.Cells(1, iCol) Like "tblOngoing*" Or xlWks.Cells(1, iCol) Like "tblActive*"

Dim iCol As Integer
For iCol = 1 To xlWkb.ActiveSheet.UsedRange.Columns.count
If xlWks.Cells(1, iCol) Like "tblOngoing*" Or xlWks.Cells(1, iCol) Like "tblActive*" Or xlWks.Cells(1, iCol) = "New" Or xlWks.Cells(1, iCol) = "Active" Or xlWks.Cells(1, iCol) = "Ongoing" Then
xlWks.Cells(1, iCol).EntireColumn.Delete
End If
Next

 

[SkipVought]

You only took HALF of my advise.

The other half is looping from RIGHT to LEFT.

"for some reasons - not deleting columns ..."

Here's why: Lets say you have TWO ADJACENT COLUMNS that need to be deleted, 1 & 2.

iCol is 1, finds the value and deletes the column

Now iCol is 2 BUT the value that WAS in 2 is now in 1 and yer past it!!!

  For iCol = xlWkb.ActiveSheet.UsedRange.Columns.count to 1 Step - 1

Skip,
[sub]
Just traded in my old subtlety...
for a NUANCE![/sub]

 

[kavya]

Thanks! yes, that was it.

 

[kavya]

Yes, that was it. Thank you.