Solved: Adding a new worksheet

[austenr]

This routine is in Access but I think somebody should be able to crack it on this forum. I have 2 subroutines that add a worksheet to an Excel workbook. The first routine (code for both posted below) works fine, the second errors off with a '1004' error. XLGibbs tried to help me with no luck. I was hoping that someone could see something. The error line is in red in the second sub. Thanks.

Sub CopyICMInputRecords()
'Copy detail records
Dim myarray As Variant
Dim objXL As Excel.Application
Dim objWkb As Excel.Workbook
Dim objSht As Excel.Worksheet
Dim db As Database
Dim rs As Recordset
Dim intLastCol As Integer
Const conMAX_ROWS = 20000
Const conSHT_NAME = "ICM Input Records"
Const conWKB_NAME = "C:\Documents and Settings\n003035\Desktop\Austens ICM\ICM Reports August 2006.xls"
Set db = CurrentDb
Set objXL = New Excel.Application
Set rs = db.OpenRecordset("ICM Account Detail for Rpt", dbOpenSnapshot)
With objXL
.Visible = True
Set objWkb = .Workbooks.Open(conWKB_NAME)
On Error Resume Next
Set objSht = objWkb.Worksheets(conSHT_NAME)
If Not Err.Number = 0 Then
Set objSht = objWkb.Worksheets.Add
objSht.Name = conSHT_NAME
End If
Err.Clear
On Error GoTo 0
intLastCol = objSht.UsedRange.Columns.Count
With objSht
.Range(.Cells(1, 1), .Cells(conMAX_ROWS, _
intLastCol)).ClearContents
.Range(.Cells(1, 1), _
.Cells(1, rs.Fields.Count)).Font.Bold = True
.Range("A2").CopyFromRecordset rs
End With
End With
'Columns("A").Select
Columns("A").Delete
Rows(1).Select
myarray = Array("Grp Inst", "Grp Acct", "Inst Nbr", "Acct Nbr", "Acct Name", "Prim Officer", "Branch", "Svc Type Desc", "Service", "Svc Code Desc", "Nbr Item", "Charge", "Unit Charge")
Range("A1:M1").Value = myarray

Range("A1:M3000").Columns.AutoFit
Columns("L:M").Select
Selection.NumberFormat = "0.00"
Set objSht = Nothing
Set objWkb = Nothing
Set objXL = Nothing
Set rs = Nothing
Set db = Nothing
End Sub


Sub CopyAcctSumRecords()
'Copy summary records
'
Dim myarray As Variant
Dim objXL As Excel.Application
Dim objWkb As Excel.Workbook
Dim objSht As Excel.Worksheet
Dim db As Database
Dim rs As Recordset
Dim intLastCol As Integer
Const conMAX_ROWS = 20000
Const conSHT_NAME = "ICM Account Summary"
Const conWKB_NAME = "C:\Documents and Settings\n003035\Desktop\Austens ICM\ICM Reports August 2006.xls"
Set db = CurrentDb
Set objXL = ThisWorkbook
Set rs = db.OpenRecordset("ICM Account Sum for Rpt", dbOpenSnapshot)
With objXL
.Visible = True
Set objWkb = .Workbooks.Open(conWKB_NAME)
On Error Resume Next
Set objSht = objWkb.Worksheets(conSHT_NAME)
If Not Err.Number = 0 Then
Set objSht = objWkb.Worksheets.Add
objSht.Name = conSHT_NAME
End If
Err.Clear
On Error GoTo 0
intLastCol = objSht.UsedRange.Columns.Count
With objSht
.Range(.Cells(1, 1), .Cells(conMAX_ROWS, _
intLastCol)).ClearContents
.Range(.Cells(1, 1), _
.Cells(1, rs.Fields.Count)).Font.Bold = True
.Range("A2").CopyFromRecordset rs
End With
End With
Columns("A").Select
Columns("A").Delete
Rows(1).Select
myarray = Array("Grp Inst", "Grp Acct", "Grp Chg Code", "Inst Nbr", "Acct Nbr", "Acct Name", "Status", "Prim Officer", "Branch", "Date Open", "Date Closed", "Avg Ldgr Bal", "Avg Coll Bal", "Chg Code", "Svc Chg Amt", "ECR", "ECR Amt", "Total Charge")
Range("A1:R1").Value = myarray

Range("A1:R3000").Columns.AutoFit
Set objSht = Nothing
Set objWkb = Nothing
Set objXL = Nothing
Set rs = Nothing
Set db = Nothing
End Sub

[mvidas]

Austen,

You're getting the error because access has no idea what "ThisWorkbook" is. Why not just use the same line from the first sub?
'Set objXL = ThisWorkbook
Set objXL = New Excel.Application

[austenr]

Matt, just to be consistent with my PM to you (just so everyone can see the thought trail I posted your suggestion here too), would that not open another instance of EXCEL.

[Bob Phillips]

Also if you Dim objXL as Excel.Application, you cannot then set it to ThisWorkbbok. Different object types.

[mvidas]

Austen,

I didn't realize you were trying to avoid another instance of excel. You can check to see if an instance already exists:
Set objXL = Nothing
On Error Resume Next
Set objXL = GetObject("Excel.Application")
On Error GoTo 0
If objXL Is Nothing Then 'no open instance
Set objXL = New Excel.Application
End If
But since you're setting .visible=true, I assumed you wanted a new instance. In any case, after this snippet you'll have objXL either pointing to an existing instance or creating a new one.

Matt

[Ken Puls]

Austen,

Have a read through this article (http://www.excelguru.ca/node/11) on my site. It answers your question to Matt re creating a new instance.

HTH,

[austenr]

Matt, added your code but it still creates another instance. Here is my code with your code inserted in sub 2. Might have put it in the wrong place.

Sub CopyICMInputRecords()
'Copy detail records
Dim myarray As Variant
Dim objXL As Excel.Application
Dim objWkb As Excel.Workbook
Dim objSht As Excel.Worksheet
Dim db As Database
Dim rs As Recordset
Dim intLastCol As Integer
Const conMAX_ROWS = 20000
Const conSHT_NAME = "ICM Input Records"
Const conWKB_NAME = "C:\Documents and Settings\n003035\Desktop\Austens ICM\ICM Reports August 2006.xls"
Set db = CurrentDb
Set objXL = New Excel.Application
Set rs = db.OpenRecordset("ICM Account Detail for Rpt", dbOpenSnapshot)
With objXL
.Visible = True
Set objWkb = .Workbooks.Open(conWKB_NAME)
On Error Resume Next
Set objSht = objWkb.Worksheets(conSHT_NAME)
If Not Err.Number = 0 Then
Set objSht = objWkb.Worksheets.Add
objSht.Name = conSHT_NAME
End If
Err.Clear
On Error GoTo 0
intLastCol = objSht.UsedRange.Columns.Count
With objSht
.Range(.Cells(1, 1), .Cells(conMAX_ROWS, _
intLastCol)).ClearContents
.Range(.Cells(1, 1), _
.Cells(1, rs.Fields.Count)).Font.Bold = True
.Range("A2").CopyFromRecordset rs
End With
End With
'Columns("A").Select
Columns("A").Delete
Rows(1).Select
myarray = Array("Grp Inst", "Grp Acct", "Inst Nbr", "Acct Nbr", "Acct Name", "Prim Officer", "Branch", "Svc Type Desc", "Service", "Svc Code Desc", "Nbr Item", "Charge", "Unit Charge")
Range("A1:M1").Value = myarray

Range("A1:M3000").Columns.AutoFit
Columns("L:M").Select
Selection.NumberFormat = "0.00"
Set objSht = Nothing
Set objWkb = Nothing
Set objXL = Nothing
Set rs = Nothing
Set db = Nothing
End Sub
Sub CopyAcctSumRecords()
'Copy summary records
'
Dim myarray As Variant
Dim objXL As Excel.Application
Dim objWkb As Excel.Workbook
Dim objSht As Excel.Worksheet
Dim db As Database
Dim rs As Recordset
Dim intLastCol As Integer
Const conMAX_ROWS = 20000
Const conSHT_NAME = "ICM Account Summary"
Const conWKB_NAME = "C:\Documents and Settings\n003035\Desktop\Austens ICM\ICM Reports August 2006.xls"
Set db = CurrentDb
Set objXL = Nothing
On Error Resume Next
Set objXL = GetObject("Excel.Application")
On Error GoTo 0
If objXL Is Nothing Then 'no open instance
Set objXL = New Excel.Application
End If
Set rs = db.OpenRecordset("ICM Account Sum for Rpt", dbOpenSnapshot)
With objXL
.Visible = True
Set objWkb = .Workbooks.Open(conWKB_NAME)
On Error Resume Next
Set objSht = objWkb.Worksheets(conSHT_NAME)
If Not Err.Number = 0 Then
Set objSht = objWkb.Worksheets.Add
objSht.Name = conSHT_NAME
End If
Err.Clear
On Error GoTo 0
intLastCol = objSht.UsedRange.Columns.Count
With objSht
.Range(.Cells(1, 1), .Cells(conMAX_ROWS, _
intLastCol)).ClearContents
.Range(.Cells(1, 1), _
.Cells(1, rs.Fields.Count)).Font.Bold = True
.Range("A2").CopyFromRecordset rs
End With
End With
Columns("A").Select
Columns("A").Delete
Rows(1).Select
myarray = Array("Grp Inst", "Grp Acct", "Grp Chg Code", "Inst Nbr", "Acct Nbr", "Acct Name", "Status", "Prim Officer", "Branch", "Date Open", "Date Closed", "Avg Ldgr Bal", "Avg Coll Bal", "Chg Code", "Svc Chg Amt", "ECR", "ECR Amt", "Total Charge")
Range("A1:R1").Value = myarray

Range("A1:R3000").Columns.AutoFit
Set objSht = Nothing
Set objWkb = Nothing
Set objXL = Nothing
Set rs = Nothing
Set db = Nothing
End Sub

[austenr]

Matt, added your code but it still creates another instance. Here is my code with your code inserted in sub 2. Might have put it in the wrong place.

Sub CopyICMInputRecords()
'Copy detail records
Dim myarray As Variant
Dim objXL As Excel.Application
Dim objWkb As Excel.Workbook
Dim objSht As Excel.Worksheet
Dim db As Database
Dim rs As Recordset
Dim intLastCol As Integer
Const conMAX_ROWS = 20000
Const conSHT_NAME = "ICM Input Records"
Const conWKB_NAME = "C:\Documents and Settings\n003035\Desktop\Austens ICM\ICM Reports August 2006.xls"
Set db = CurrentDb
Set objXL = New Excel.Application
Set rs = db.OpenRecordset("ICM Account Detail for Rpt", dbOpenSnapshot)
With objXL
.Visible = True
Set objWkb = .Workbooks.Open(conWKB_NAME)
On Error Resume Next
Set objSht = objWkb.Worksheets(conSHT_NAME)
If Not Err.Number = 0 Then
Set objSht = objWkb.Worksheets.Add
objSht.Name = conSHT_NAME
End If
Err.Clear
On Error GoTo 0
intLastCol = objSht.UsedRange.Columns.Count
With objSht
.Range(.Cells(1, 1), .Cells(conMAX_ROWS, _
intLastCol)).ClearContents
.Range(.Cells(1, 1), _
.Cells(1, rs.Fields.Count)).Font.Bold = True
.Range("A2").CopyFromRecordset rs
End With
End With
'Columns("A").Select
Columns("A").Delete
Rows(1).Select
myarray = Array("Grp Inst", "Grp Acct", "Inst Nbr", "Acct Nbr", "Acct Name", "Prim Officer", "Branch", "Svc Type Desc", "Service", "Svc Code Desc", "Nbr Item", "Charge", "Unit Charge")
Range("A1:M1").Value = myarray

Range("A1:M3000").Columns.AutoFit
Columns("L:M").Select
Selection.NumberFormat = "0.00"
Set objSht = Nothing
Set objWkb = Nothing
Set objXL = Nothing
Set rs = Nothing
Set db = Nothing
End Sub
Sub CopyAcctSumRecords()
'Copy summary records
'
Dim myarray As Variant
Dim objXL As Excel.Application
Dim objWkb As Excel.Workbook
Dim objSht As Excel.Worksheet
Dim db As Database
Dim rs As Recordset
Dim intLastCol As Integer
Const conMAX_ROWS = 20000
Const conSHT_NAME = "ICM Account Summary"
Const conWKB_NAME = "C:\Documents and Settings\n003035\Desktop\Austens ICM\ICM Reports August 2006.xls"
Set db = CurrentDb
Set objXL = Nothing
On Error Resume Next
Set objXL = GetObject("Excel.Application")
On Error GoTo 0
If objXL Is Nothing Then 'no open instance
Set objXL = New Excel.Application
End If
Set rs = db.OpenRecordset("ICM Account Sum for Rpt", dbOpenSnapshot)
With objXL
.Visible = True
Set objWkb = .Workbooks.Open(conWKB_NAME)
On Error Resume Next
Set objSht = objWkb.Worksheets(conSHT_NAME)
If Not Err.Number = 0 Then
Set objSht = objWkb.Worksheets.Add
objSht.Name = conSHT_NAME
End If
Err.Clear
On Error GoTo 0
intLastCol = objSht.UsedRange.Columns.Count
With objSht
.Range(.Cells(1, 1), .Cells(conMAX_ROWS, _
intLastCol)).ClearContents
.Range(.Cells(1, 1), _
.Cells(1, rs.Fields.Count)).Font.Bold = True
.Range("A2").CopyFromRecordset rs
End With
End With
Columns("A").Select
Columns("A").Delete
Rows(1).Select
myarray = Array("Grp Inst", "Grp Acct", "Grp Chg Code", "Inst Nbr", "Acct Nbr", "Acct Name", "Status", "Prim Officer", "Branch", "Date Open", "Date Closed", "Avg Ldgr Bal", "Avg Coll Bal", "Chg Code", "Svc Chg Amt", "ECR", "ECR Amt", "Total Charge")
Range("A1:R1").Value = myarray

Range("A1:R3000").Columns.AutoFit
Set objSht = Nothing
Set objWkb = Nothing
Set objXL = Nothing
Set rs = Nothing
Set db = Nothing
End Sub

[mvidas]

What you have looks right.. are you sure the new instance isn't coming from the first sub?

[austenr]

Yes I think so. I F8 through the first sub and it opens the instance, creates the sheet and populates it along with other housekeeping stuff. Then if you F8 through the second sub, another instance pops up when you get to the .visible = true.

[mvidas]

And you didn't have a hidden instance anywhere? I don't know of another way to do it, hopefully someone else can help

[austenr]

Perhaps another solution would be to somehow make two sheets then do the data transfer. If there a way to rename two of the sheets something like Acct" and "Maint" when the instance is created and then do the routine to parse the data to excel?

[mvidas]

D'oh! Stupid me
'Set objXL = GetObject("Excel.Application")
Set objXL = GetObject(, "Excel.Application")

[austenr]

That worked Matt thanks. Another problem has cropped up though. In the second Sub, there is a warning box that pops up asking if I want to re open the workbook.

With objXL
.Visible = True
Set objWkb = .Workbooks.Open(conWKB_NAME)
On Error Resume Next
Set objSht = objWkb.Worksheets(conSHT_NAME)
If Not Err.Number = 0 Then
Set objSht = objWkb.Worksheets.Add
objSht.Name = conSHT_NAME
End If
Err.Clear
On Error GoTo 0
intLastCol = objSht.UsedRange.Columns.Count
With objSht
.Range(.Cells(1, 1), .Cells(conMAX_ROWS, _
intLastCol)).ClearContents
.Range(.Cells(1, 1), _
.Cells(1, rs.Fields.Count)).Font.Bold = True
.Range("A2").CopyFromRecordset rs
End With

If i try to comment out the Set workbook.open part of the code above, you get a With block error.

[Ken Puls]

On Error Resume Next
Set objWkb = .Workbooks(conWKB_NAME)
If Err.Number <> 0 Then
Set objWkb = .Workbooks.Open(conWKB_NAME)
End If
On Error Goto 0

(Written in the browser and not tested)

[austenr]

Ken,

Tried your code (see below) and now i get a With with no matching end with error.

Sub CopyAcctSumRecords()
'Copy summary records
'
Dim myarray As Variant
Dim objXL As Excel.Application
Dim objWkb As Excel.Workbook
Dim objSht As Excel.Worksheet
Dim db As Database
Dim rs As Recordset
Dim intLastCol As Integer
Const conMAX_ROWS = 20000
Const conSHT_NAME = "ICM Account Summary"
Const conWKB_NAME = "C:\Documents and Settings\n003035\Desktop\Austens ICM\ICM Reports August 2006.xls"
Set db = CurrentDb
Set objXL = Nothing
On Error Resume Next
Set objXL = GetObject("Excel.Application")
On Error GoTo 0
If objXL Is Nothing Then 'no open instance
Set objXL = New Excel.Application
End If
Set rs = db.OpenRecordset("ICM Account Sum for Rpt", dbOpenSnapshot)
With objXL
.Visible = True
On Error Resume Next
Set objWkb = .Workbooks(conWKB_NAME)
If Err.Number <> 0 Then
Set objWkb = .Workbooks(conWKB_NAME)
'Set objWkb = .Workbooks.Open(conWKB_NAME)
'On Error Resume Next
Set objSht = objWkb.Worksheets(conSHT_NAME)
If Not Err.Number = 0 Then
Set objSht = objWkb.Worksheets.Add
objSht.Name = conSHT_NAME
End If
Err.Clear
On Error GoTo 0
intLastCol = objSht.UsedRange.Columns.Count
With objSht
.Range(.Cells(1, 1), .Cells(conMAX_ROWS, _
intLastCol)).ClearContents
.Range(.Cells(1, 1), _
.Cells(1, rs.Fields.Count)).Font.Bold = True
.Range("A2").CopyFromRecordset rs
End With
End With
Columns("A").Select
Columns("A").Delete
Rows(1).Select
myarray = Array("Grp Inst", "Grp Acct", "Grp Chg Code", "Inst Nbr", "Acct Nbr", "Acct Name", "Status", "Prim Officer", "Branch", "Date Open", "Date Closed", "Avg Ldgr Bal", "Avg Coll Bal", "Chg Code", "Svc Chg Amt", "ECR", "ECR Amt", "Total Charge")
Range("A1:R1").Value = myarray

Range("A1:R3000").Columns.AutoFit
Set objSht = Nothing
Set objWkb = Nothing
Set objXL = Nothing
Set rs = Nothing
Set db = Nothing
End Sub

[Ken Puls]

Try this:

Sub CopyAcctSumRecords()
'Copy summary records
'
Dim myarray As Variant
Dim objXL As Excel.Application
Dim objWkb As Excel.Workbook
Dim objSht As Excel.Worksheet
Dim db As Database
Dim rs As Recordset
Dim intLastCol As Integer
Const conMAX_ROWS = 20000
Const conSHT_NAME = "ICM Account Summary"
Const conWKB_NAME = "C:\Documents and Settings\n003035\Desktop\Austens ICM\ICM Reports August 2006.xls"
Set db = CurrentDb
Set objXL = Nothing
On Error Resume Next
Set objXL = GetObject("Excel.Application")
On Error GoTo 0
If objXL Is Nothing Then 'no open instance
Set objXL = New Excel.Application
End If
Set rs = db.OpenRecordset("ICM Account Sum for Rpt", dbOpenSnapshot)
With objXL
.Visible = True
On Error Resume Next
Set objWkb = .Workbooks(conWKB_NAME)
If Err.Number <> 0 Then Set objWkb = .Workbooks.Open(conWKB_NAME)
Err.Clear
Set objSht = objWkb.Worksheets(conSHT_NAME)
If Not Err.Number = 0 Then
Set objSht = objWkb.Worksheets.Add
objSht.Name = conSHT_NAME
End If
Err.Clear
On Error GoTo 0
intLastCol = objSht.UsedRange.Columns.Count
With objSht
.Range(.Cells(1, 1), .Cells(conMAX_ROWS, _
intLastCol)).ClearContents
.Range(.Cells(1, 1), _
.Cells(1, rs.Fields.Count)).Font.Bold = True
.Range("A2").CopyFromRecordset rs
End With
End With
Columns("A").Select
Columns("A").Delete
Rows(1).Select
myarray = Array("Grp Inst", "Grp Acct", "Grp Chg Code", "Inst Nbr", "Acct Nbr", "Acct Name", "Status", "Prim Officer", "Branch", "Date Open", "Date Closed", "Avg Ldgr Bal", "Avg Coll Bal", "Chg Code", "Svc Chg Amt", "ECR", "ECR Amt", "Total Charge")
Range("A1:R1").Value = myarray

Range("A1:R3000").Columns.AutoFit
Set objSht = Nothing
Set objWkb = Nothing
Set objXL = Nothing
Set rs = Nothing
Set db = Nothing
End Sub

[lucas]

Can't believe I've been put on hold again with no music....?

[Ken Puls]

ROFL!

[austenr]

Ken,

That makes another instance when it encounters the .visible command.

[Ken Puls]

Austen,

Look at Matt's comment in post 13 of this thread...

[austenr]

Here is what I havew currently. I seem to be missing the point or where things truly go. I did add Matts suggestion in post 13. What is happening now is that this code:

If Err.Number <> 0 Then Set objWkb = .Workbooks.Open(conWKB_NAME)

is TRUE so it tries to open another workbook. My whole code is below.

Sub CopyAcctSumRecords()

'Copy summary records
'
Dim myarray As Variant
Dim objXL As Excel.Application
Dim objWkb As Excel.Workbook
Dim objSht As Excel.Worksheet
Dim db As Database
Dim rs As Recordset
Dim intLastCol As Integer
Const conMAX_ROWS = 20000
Const conSHT_NAME = "ICM Account Summary"
Const conWKB_NAME = "C:\Documents and Settings\n003035\Desktop\Austens ICM\ICM Reports August 2006.xls"
Set db = CurrentDb
Set objXL = Nothing
On Error Resume Next
Set objXL = GetObject(, "Excel.Application")
On Error GoTo 0
If objXL Is Nothing Then 'no open instance
Set objXL = New Excel.Application
End If
Set rs = db.OpenRecordset("ICM Account Sum for Rpt", dbOpenSnapshot)
With objXL
.Visible = True
On Error Resume Next
Set objWkb = .Workbooks(conWKB_NAME)
If Err.Number <> 0 Then Set objWkb = .Workbooks.Open(conWKB_NAME)
Err.Clear
Set objSht = objWkb.Worksheets(conSHT_NAME)
If Not Err.Number = 0 Then
Set objSht = objWkb.Worksheets.Add
objSht.Name = conSHT_NAME
End If
Err.Clear
On Error GoTo 0
intLastCol = objSht.UsedRange.Columns.Count
With objSht
.Range(.Cells(1, 1), .Cells(conMAX_ROWS, _
intLastCol)).ClearContents
.Range(.Cells(1, 1), _
.Cells(1, rs.Fields.Count)).Font.Bold = True
.Range("A2").CopyFromRecordset rs
End With
End With
Columns("A").Select
Columns("A").Delete
Rows(1).Select
myarray = Array("Grp Inst", "Grp Acct", "Grp Chg Code", "Inst Nbr", "Acct Nbr", "Acct Name", "Status", "Prim Officer", "Branch", "Date Open", "Date Closed", "Avg Ldgr Bal", "Avg Coll Bal", "Chg Code", "Svc Chg Amt", "ECR", "ECR Amt", "Total Charge")
Range("A1:R1").Value = myarray

Range("A1:R3000").Columns.AutoFit
Set objSht = Nothing
Set objWkb = Nothing
Set objXL = Nothing
Set rs = Nothing
Set db = Nothing
End Sub

[Ken Puls]

Ah... okay, I see what's going on...

Break this up:

Const conWKB_NAME = "C:\Documents and Settings\n003035\Desktop\Austens ICM\ICM Reports August 2006.xls"
Into:
Const conWKB_PATH = "C:\Documents and Settings\n003035\Desktop\Austens ICM\"
Const conWKB_NAME = "ICM Reports August 2006.xls"
Then change this line:

If Err.Number <> 0 Then Set objWkb = .Workbooks.Open(conWKB_NAME) To this:

If Err.Number <> 0 Then Set objWkb = .Workbooks.Open(conWKB_PATH & conWKB_NAME)

[austenr]

ok how do you Dim this conWKB_NAME

[Norie]

One possible reason for the code seemingly creating a new instance or leaving an instance of Excel is the unqualified references here.

Columns("A").Select
Columns("A").Delete
Rows(1).Select
myarray = Array("Grp Inst", "Grp Acct", "Grp Chg Code", "Inst Nbr", "Acct Nbr", "Acct Name", "Status", "Prim Officer", "Branch", "Date Open", "Date Closed", "Avg Ldgr Bal", "Avg Coll Bal", "Chg Code", "Svc Chg Amt", "ECR", "ECR Amt", "Total Charge")
Range("A1:R1").Value = myarray

Range("A1:R3000").Columns.AutoFit
Tushar Mehta has a good write up on it here. (http://www.tushar-mehta.com/excel/vba/xl_doesnt_quit)

[austenr]

I figured it out Ken. My thanks to you and Matt for helping me clear this hurdle. It is working as I want it to.