PDA

View Full Version : Sleeper: Current page method of pivot field failed



stock11r
08-12-2005, 03:26 PM
Problem:
Run time error 2147417848 (80010108)
?Current page method of pivot field failed?

My macro ran once perfectly, but each subsequent time Excel freezes up and I have to shut Excel down. Looks like an automation error.

Operating System: Windows 2000 Pro, Excel 2003


Experience: I don?t have much Excel VBA experience ? no formal education.


Background:
I designed a pivot table based on a dynamic range (size is usually 5000 rows by 70 columns). My macro creates report sheets based on this pivot table by automatically switching the ?page? field, and then copying and pasting the relevant data into new worksheets that are created when the macro is run.


The worksheets are named the same as the page field of the pivot table. Just as an example (not the same fields as my P.T), if page fields are large American cities, and the user wants reports for ?Houston? and ?Jacksonville?, they select these names from a validated list in the pivot table worksheet (this list is not a part of the pivot table), then start the macro. The macro automatically creates new worksheets that are named ?Houston? and ?Jacksonville? which contain the report for the city.

Steps Taken:


1) I?ve read the full version of Mike?s xtremeVB thread on ?Automating Excel from VB 6.0? which includes MSKB 178510 & MSKB 319832 aritcles. (http://www.xtremevbtalk.com/archive/index.php/t-135815 (http://www.xtremevbtalk.com/archive/index.php/t-135815))


2) I?ve followed all the steps outlined in the article, including defining an object for the current instance of Excel, preceeding every function with this object, while using the ?Automation Prophylactics? to compile all of my code to ensure there are no calls to a Global Object.

3) Closed this object at the end of my code.


Where I am Now: Excel still freezes everytime I run my code. I cannot select any cells or do anything else.


Thank you very much to anyone who can help me with this problem. If this post is in any way improper or in the wrong place, please feel free to correct me.


Option Explicit
Public IntStartDay As Integer
Public IntEndDay As Integer
Public IntStartMonth As Integer
Public IntEndMonth As Integer
Public StrStartMonth As String
Public StrEndMonth As String
Public CurrentYear As Integer
Public Historical As String
Public oExcel As Excel.Application
Public oWB As Excel.Workbook
Public oWS As Excel.Worksheet
Public oWSLoop As Excel.Worksheet

Public Sub GradeSheets()
'Dim oExcel As Excel.Application
'Dim oWB As Excel.Workbook
'Dim oWS As Excel.Worksheet
'Dim oWSLoop As Excel.Worksheet
On Error Resume Next
Set oExcel = GetObject(, "Excel.Application")
Set oWB = oExcel.Workbooks("PM#4 - Grades - TPD")
Set oWS = oWB.Worksheets("Grade Sheet Calculator")
oExcel.ScreenUpdating = False
oExcel.Calculation = xlCalculationManual
' "GradeSheets" Macro - PM#4
' This macro extracts data from the
' "Grade Sheet Calculator" worksheet and uses it
' to create grade sheets for sorted by tonnes per day.
' Richard Stock
' June 30, 2005
oWB.Colors(48) = RGB(202, 6, 6)
oWS.Rows("2:1000").Select
oExcel.Selection.EntireRow.Hidden = False
'Declare Variables
Dim NumColumns As Integer
Dim StartDate
Dim EndDate
Dim StDate As String
Dim EndDte As String
Dim ActStDate
Dim ActEndDate
Dim x, y As Integer
Dim GradeSheet As String
'Initialize Variables
NumColumns = 2
IntStartDay = Day(oWS.Cells(1, 7).Value)
IntEndDay = Day(oWS.Cells(2, 7).Value)
IntStartMonth = Month(oWS.Cells(1, 7).Value)
IntEndMonth = Month(oWS.Cells(2, 7).Value)
CurrentYear = Year(oWS.Cells(1, 7).Value)
If CurrentYear < 2003 Then
IntStartMonth = Month(oWB.Sheets("Raw Data").Cells(2, 3).Value)
IntEndMonth = Month(oWB.Sheets("Raw Data").Cells(3, 3).Value)
CurrentYear = Year(Now)
End If
If IntStartMonth = 1 Then StrStartMonth = "Jan"
If IntStartMonth = 2 Then StrStartMonth = "Feb"
If IntStartMonth = 3 Then StrStartMonth = "March"
If IntStartMonth = 4 Then StrStartMonth = "April"
If IntStartMonth = 5 Then StrStartMonth = "May"
If IntStartMonth = 6 Then StrStartMonth = "June"
If IntStartMonth = 7 Then StrStartMonth = "July"
If IntStartMonth = 8 Then StrStartMonth = "August"
If IntStartMonth = 9 Then StrStartMonth = "Sept"
If IntStartMonth = 10 Then StrStartMonth = "October"
If IntStartMonth = 11 Then StrStartMonth = "Nov"
If IntStartMonth = 12 Then StrStartMonth = "Dec"
If IntEndMonth = 1 Then StrEndMonth = "Jan"
If IntEndMonth = 2 Then StrEndMonth = "Feb"
If IntEndMonth = 3 Then StrEndMonth = "March"
If IntEndMonth = 4 Then StrEndMonth = "April"
If IntEndMonth = 5 Then StrEndMonth = "May"
If IntEndMonth = 6 Then StrEndMonth = "June"
If IntEndMonth = 7 Then StrEndMonth = "July"
If IntEndMonth = 8 Then StrEndMonth = "August"
If IntEndMonth = 9 Then StrEndMonth = "Sept"
If IntEndMonth = 10 Then StrEndMonth = "October"
If IntEndMonth = 11 Then StrEndMonth = "Nov"
If IntEndMonth = 12 Then StrEndMonth = "Dec"
If StrStartMonth = StrEndMonth Then
If IntEndDay - IntStartDay > 25 Then
Historical = "Historical Averages for " & StrStartMonth & " " & CurrentYear
ElseIf IntEndDay - IntStartDay = 7 Then
Historical = "Historical Averages for Week of " & StrStartMonth & " " & IntStartDay & " - " & StrEndMonth & " " & IntEndDay & ", " & CurrentYear
Else
Historical = "Historical Averages for " & StrStartMonth & " " & IntStartDay & " - " & StrEndMonth & " " & IntEndDay & ", " & CurrentYear
End If
ElseIf IntStartMonth < IntEndMonth Then
Historical = "Historical Averages for " & StrStartMonth & " - " & StrEndMonth & " " & CurrentYear
Else
Historical = "Historical Averages for " & StrStartMonth & " - " & StrEndMonth & " " & CurrentYear
End If
StartDate = oWS.Cells(1, 7).Value
EndDate = oWS.Cells(2, 7).Value
ActStDate = oWS.Cells(1, 4).Value
ActEndDate = oWS.Cells(2, 4).Value
StDate = "<" & ActStDate
EndDte = ">" & ActEndDate
'Hide Dates That are Outside Of User Selected Date Range
oWS.Range("B3").Select
If oWS.Cells(2, 4).Value = "" Then
oExcel.Selection.Group Start:=True, End:=True, By:=1, Periods:=Array(False, _
False, False, True, False, False, False)
Else
oExcel.Selection.Group Start:=StartDate, End:=EndDate, By:=1, Periods:=Array(False, _
False, False, True, False, False, False)
With oWS.PivotTables("Summary").PivotFields("TIMESTAMP")
.PivotItems(StDate).Visible = False
.PivotItems(EndDte).Visible = False
End With
End If
Application.Run "'PM#4 - Grades - TPD.xls'!CreateSheets"
End Sub

Public Sub CreateSheets()
'DELETE OLD GRADESHEETS
If oWS.Cells(1014, 1).Value = "Yes" Then
y = oWB.Sheets.Count
oExcel.DisplayAlerts = False
For x = 4 To y
oWB.Worksheets(4).Delete
Next x
oExcel.DisplayAlerts = True
End If
'DECLARE VARIABLES
Static a, b, c, aLoop As Integer
Dim TopDataCellRow, LeftmostDataCellCol, NumberofDataColumns As Integer
Dim PM4FirstTagRow, PM4TagColumn, NumberofWorksheets As Integer
Dim UnitsPath As String
Dim Grade As String
Dim GradeNumber As Variant
Dim TopLeftDataCell As String
Dim Average As Range
Dim ExitLoop As Boolean
Dim strAverageAddress As String
Dim intAverageAddress As Integer
Dim KeepGoin As Boolean
Dim LoopCounter As Integer
Dim NumberofMissingColumns As Integer
'Create Grade Sheets
LoopCounter = 1002
KeepGoin = False
Do
If oWS.Cells(LoopCounter, 1) = "" Then
Exit Do
Else
KeepGoin = True
End If
oExcel.ScreenUpdating = False ' Disables screen changes
'INITIALIZE VARIABLES
If oWS.Cells(LoopCounter, 1) = "All" Then
Grade = "(All)"
Else
Grade = Trim(Str(oWS.Cells(LoopCounter, 1))) ' Grade of paper
End If
TopDataCellRow = 6 ' Row of data immediately after headings
LeftmostDataCellCol = 3 ' Column of data immediately after units column (A=1,B=2,C=3,etc)
NumberofDataColumns = 7 ' # of Data Columns Not Including "Avg." column
PM4FirstTagRow = 9 ' Row number of first tag in "Tags" worksheet (PM # 4)
PM4TagColumn = 2 ' Column number of first tag in "Tags" worksheet (PM # 4) - (A=1,B=2,C=3,etc)
UnitsPath = "='[Data Extractor.xls]Tags'!R" ' Excel link to "Tags" worksheet
'CREATE GRADESHEET
If StrStartMonth = StrEndMonth Then
If IntEndDay - IntStartDay > 25 Then
GradeSheet = Grade & " (" & StrStartMonth & ", " & CurrentYear & ")"
ElseIf IntEndDay - IntStartDay = 7 Then
GradeSheet = Grade & " (" & StrStartMonth & " " & IntStartDay & " - " & StrEndMonth & " " & IntEndDay & ", " & CurrentYear & ")"
Else
End If
ElseIf IntStartMonth < IntEndMonth Then
GradeSheet = Grade & " (" & StrStartMonth & " - " & StrEndMonth & ", " & CurrentYear & ")"
Else
End If
NumberofWorksheets = oWB.Worksheets.Count
oWB.Worksheets.Add After:=oWB.Worksheets(NumberofWorksheets)
oWB.ActiveSheet.Name = GradeSheet
Set oWSLoop = oWB.Worksheets(GradeSheet)
'LINK DESCRIPTIONS
GetData oExcel.ThisWorkbook.Path & "\Data Extractor.xls", "Tags", "A8:A150", oWSLoop.Range("A6"), True
' Windows("Data Extractor.xls").Activate
' oExcel.Run "'Data Extractor.xls'!WBActivateHandler"
' Sheets("Tags").Select
' Range("A8:A150").Select
' Selection.Copy
' Windows("PM#4 - Grades - TPD.xls").Activate
' oWSLoop.Range("A6").Select
' oWSLoop.Paste Link:=True
oWB.ActiveSheet.Range("A4").FormulaR1C1 = "Production at Reel (tonnes/day)"
oWSLoop.Range("A4").Select
oExcel.Selection.Font.Bold = True
oExcel.Selection.Font.Italic = True
oWSLoop.Columns("A:A").ColumnWidth = 33.78
oWSLoop.Range("A6").Select
oExcel.Selection.FormatConditions.Delete
oExcel.Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, _
Formula1:="0"
oExcel.Selection.FormatConditions(1).Font.ColorIndex = 2
oExcel.Selection.Copy
oWSLoop.Range("A7:B150").Select
oExcel.Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
oWSLoop.Range("A6").Select
oExcel.Selection.Font.Bold = True
oExcel.Selection.Font.Underline = xlUnderlineStyleSingle
oWSLoop.Columns("B:B").Select
With oExcel.Selection.Font
.Name = "Arial"
.Size = 8
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
'COPY AND PASTE DATA INTO GRADESHEETS
oWS.Select
' To avoid run-time errors set the following property to True.
'ActiveSheet.PivotTables("Summary").CubeFields("GRADE").EnableMultiplePageItems = True
oWB.ActiveSheet.PivotTables("Summary").PivotFields("GRADE").CurrentPage = Grade
aLoop = oExcel.WorksheetFunction.CountIf(oWS.Columns(1), "Average")
If aLoop = 0 Then
oExcel.DisplayAlerts = False
oWB.Worksheets(NumberofWorksheets + 1).Delete
oExcel.DisplayAlerts = True
GoTo LastLine
End If
b = LeftmostDataCellCol
Set Average = oWS.Range("A4")
For a = 1 To aLoop
oWS.Select
' Find "Average" in Column "A"
Set Average = oWS.Columns(1).Find(What:="Average", After:=Average, LookIn:=xlValues, Lookat:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=True)
' Copy heading
Average.Activate
strAverageAddress = Mid(oExcel.ActiveCell.Address, 4)
intAverageAddress = Val(strAverageAddress) + 1
oWS.Range(oExcel.Selection, oExcel.Selection.End(xlUp)).Select
intAverageAddress = intAverageAddress - oExcel.Selection.Rows.Count
oWS.Cells(intAverageAddress, 1).Select
oExcel.Selection.Copy
oWSLoop.Select
oWSLoop.Cells(4, b).Select
oExcel.Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
' Copy data
oWS.Select
Average.Activate
oExcel.ActiveCell.Offset(0, 2).Select
oWS.Range(oExcel.ActiveCell, oExcel.ActiveCell.End(xlToRight)).Select
oExcel.Selection.Copy
oWSLoop.Select
oWSLoop.Cells(TopDataCellRow, b).Select
oExcel.Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True
oExcel.CutCopyMode = False
b = b + 1
Next a
oWS.Select
Set Average = oWS.Range("A4")
Set Average = oWS.Columns(1).Find(What:="Grand Average", After:=Average, LookIn:=xlValues, Lookat:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=True)
Average.Activate
oExcel.ActiveCell.Offset(0, 2).Select
oWS.Range(oExcel.ActiveCell, oExcel.ActiveCell.End(xlToRight)).Select
oExcel.Selection.Copy
oWSLoop.Select
oWSLoop.Cells(TopDataCellRow, b).Select
oExcel.Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True
oExcel.CutCopyMode = False
oWSLoop.Cells(4, b).FormulaR1C1 = "Avg."
oWSLoop.Range(oWSLoop.Cells(4, LeftmostDataCellCol), oWSLoop.Cells(4, b)).Select
oExcel.Selection.Font.Bold = True
With oExcel.Selection
.HorizontalAlignment = xlRight
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
' Format White Background for top 2 rows
oWSLoop.Range(oWSLoop.Cells(1, 1), oWSLoop.Cells(2, b)).Select
With oExcel.Selection.Interior
.ColorIndex = 2
.Pattern = xlSolid
End With
oExcel.Selection.Borders(xlDiagonalDown).LineStyle = xlNone
oExcel.Selection.Borders(xlDiagonalUp).LineStyle = xlNone
oExcel.Selection.Borders(xlEdgeLeft).LineStyle = xlNone
oExcel.Selection.Borders(xlEdgeTop).LineStyle = xlNone
With oExcel.Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
oExcel.Selection.Borders(xlEdgeRight).LineStyle = xlNone
oExcel.Selection.Borders(xlInsideVertical).LineStyle = xlNone
oExcel.Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
' Copy "Hercules" logo over to gradesheet (TOP LEFT)
oWS.Select
oWB.ActiveSheet.Shapes("Group 46").Select
oExcel.Selection.Copy
oWSLoop.Select
oWSLoop.Range("A1").Select
oWB.ActiveSheet.Paste
oExcel.Selection.ShapeRange.LockAspectRatio = msoTrue
oExcel.Selection.ShapeRange.Height = 16.8
oExcel.Selection.ShapeRange.Width = 174.6
oExcel.Selection.ShapeRange.Rotation = 0#
' Insert PM # 4 Heading (TOP RIGHT)
oWSLoop.Cells(2, b).FormulaR1C1 = "PM # 4"
oWSLoop.Cells(2, b).Select
oExcel.Selection.Font.Bold = True
oExcel.Selection.Font.Italic = True
With oExcel.Selection.Font
.Name = "Arial"
.Size = 12
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
oExcel.Selection.Font.ColorIndex = 48
' Insert "Historical Averages For" Statement (TOP RIGHT)
oWSLoop.Range(oWSLoop.Cells(1, 2), oWSLoop.Cells(1, b)).Select
oExcel.Selection.ClearContents
oWSLoop.Cells(1, b - 2).Value = Historical
oWSLoop.Cells(1, b - 2).Select
With oExcel.Selection.Font
.Name = "Arial"
.Size = 9
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
oExcel.Selection.Font.Italic = True
' SHIFT DATA
b = LeftmostDataCellCol
NumberofMissingColumns = 0
Do
If IsEmpty(oWSLoop.Cells(TopDataCellRow, b).Value) = True Then
NumberofMissingColumns = NumberofMissingColumns + 1
End If
b = b + 1
Loop While b < NumberofDataColumns + LeftmostDataCellCol
oWSLoop.Cells(TopDataCellRow, LeftmostDataCellCol).Select
oExcel.ActiveCell.CurrentRegion.Select
oExcel.Selection.Cut Destination:=oExcel.ActiveCell.Offset(0, NumberofMissingColumns)
b = TopDataCellRow
ExitLoop = False
Do
If oWSLoop.Cells(b, 1).Value = "0" Then
oWSLoop.Cells(b, LeftmostDataCellCol).Select
oWSLoop.Range(oExcel.ActiveCell, oExcel.ActiveCell.End(xlToRight)).Select
oExcel.Selection.Insert Shift:=xlDown
oExcel.Selection.Insert Shift:=xlDown
b = b + 1
If oWSLoop.Cells(b, 1).Value = "0" Then
ExitLoop = True
Else
oWSLoop.Cells(b, 1).Select
oExcel.Selection.Font.Bold = True
oExcel.Selection.Font.Underline = xlUnderlineStyleSingle
b = b - 1
End If
End If
b = b + 1
Loop While ExitLoop = False
ExitLoop = False
b = TopDataCellRow + 1
c = PM4FirstTagRow
Do
If oWSLoop.Cells(b, 1).Value = "0" Then
b = b + 1
If oWSLoop.Cells(b, 1).Value = "0" Then
ExitLoop = True
Else
b = b - 1
End If
End If
oWSLoop.Cells(b, 2).FormulaR1C1 = UnitsPath & c & "C" & PM4TagColumn
b = b + 1
c = c + 1
Loop While ExitLoop = False
oWSLoop.Range(oWSLoop.Cells(TopDataCellRow, LeftmostDataCellCol), oWSLoop.Cells(300, 20)).Select
oExcel.Selection.Font.Bold = False
With oExcel.Selection
.HorizontalAlignment = xlRight
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
With oExcel.Selection.Font
.Name = "Arial"
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
With oExcel.Selection.Font
.Name = "Arial"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
oExcel.Selection.NumberFormat = "0.000"
oWSLoop.Columns("E:E").ColumnWidth = 9.22
oWSLoop.Range(oWSLoop.Cells(TopDataCellRow, LeftmostDataCellCol), oWSLoop.Cells(TopDataCellRow, 20)).Select
oExcel.Selection.Font.Italic = True
oExcel.Selection.NumberFormat = "0"
oExcel.Selection.Font.ColorIndex = 48
oWSLoop.Cells(TopDataCellRow, 2).FormulaR1C1 = "COUNT"
oWSLoop.Cells(TopDataCellRow, 2).Select
oExcel.Selection.Font.ColorIndex = 48
' Insert Grade Heading
oWSLoop.Cells(2, 4).FormulaR1C1 = "Grade"
oWSLoop.Cells(2, 5).FormulaR1C1 = Grade
oWSLoop.Range(oWSLoop.Cells(2, 4), oWSLoop.Cells(2, 5)).Select
oExcel.Selection.Font.Bold = True
With oExcel.Selection.Font
.Name = "Arial"
.Size = 16
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
oExcel.ActiveWindow.Zoom = 85
oWS.Select
oExcel.ScreenUpdating = True
LastLine:
LoopCounter = LoopCounter + 1
Loop While KeepGoin = True
oExcel.Calculation = xlCalculationAutomatic
oExcel.ScreenUpdating = True
'Clean up
Set oWS = Nothing
Set oWSLoop = Nothing
'If Not oWB Is Nothing Then oWB.Close
Set oWB = Nothing
'oExcel.Quit
Set oExcel = Nothing
End Sub

Insomniac
08-16-2005, 09:24 AM
Hello stock11r, since you have zero replies I will have a stab at it.


Just a couple of observations.

1) The code you have posted is lengthy & hard to follow without the forum VBA tag formatting.

2) There are some critical declarations commented out
eg:
'Dim oExcel As Excel.Application
I assume this is erroneous since you have Option Explicit applied?

3) The very 1st peice of code:

On Error Resume Next
Set oExcel = GetObject(, "Excel.Application")
Set oWB = oExcel.Workbooks("PM#4 - Grades - TPD")
Set oWS = oWB.Worksheets("Grade Sheet Calculator")

GetObject will return the 1st Excel instance created, the code assumes this will be the one it wants & then also assumes that the Workbook ("PM#4 - Grades - TPD") is actually open in it & that it does in fact contain the sheet "Grade Sheet Calculator" . 'On Error Resume Next' ensures that no errors are reported & the rest of the code is in fact running under the same premise?

4) I see peices of code like:

oWS.Rows("2:1000").Select
oExcel.Selection.EntireRow.Hidden = False
could be optimized to:

oWS.Rows("2:1000").EntireRow.Hidden = False


5)What exacly is this call doing ? :


GetData oExcel.ThisWorkbook.Path & "\Data Extractor.xls", "Tags", "A8:A150", oWSLoop.Range("A6"), True

6)
With oWS.PivotTables("Summary").PivotFields("TIMESTAMP")
.PivotItems(StDate).Visible = False
.PivotItems(EndDte).Visible = False
End With

Possible the most critical peice of code, excel will happily let you refer to feilds in a pivot table that dont even actullay exist without raising a runtime error!. The consequence is as you describe that you are left with an instance of excel that you cannot even select any cells, etc. & require a Ctrl>Alt>Del to close.


I would start by removing the On Error bit & explicitly test for valid data to try to find out where the problem originates.
(is it the correct workbook, are the dates & months valid & do they exist in the table feilds, etc....)

Anyway I hope some insite maybe forthcoming.

geekgirlau
08-16-2005, 03:39 PM
Stock11r, this might be a stupid question, but is this code running in VB or in VBA (ie from Excel)? Because if you are running VBA, there is no need to declare the Excel application as an object.

There are a few other things you could do to streamline the code, but the most important thing is to get it running - how did you go with Insomniac's suggestions?

By the way, be sure to use the VBA tags around your code when you post it - makes it a bit easier to read.

Ken Puls
08-16-2005, 03:50 PM
Hey guys,

Edited Stock11r's post to use the VBA tags. There's still a ton of extra linefeeds in there, but I don't think I'm going to spend any time wiping those.

Cheers!