I have written a VBA code to step through a selection of hyperlinks and grab data from each file.
On the 2nd pass through the loop (when I run the macro), I get an err 9 - subscript out of range. When I step through the macro via the F8 button, it runs fine.
I have done a debug while running and the Range(x.Address) has the correct cell address. If I run the code for the line that fails as the first entry, it works.
It just fails on the 2nd run.
Sub HistoricRevData()
On Error GoTo MHSErrorHandler:
Dim WB_MonthlyLoad As Object
Dim WB_ProjectSummary As Object
Dim WS_MonthSht As Object
Dim WS_PerComSht As Object
Dim WS_PriceSht As Object
Dim WS_RevSht As Object
Dim varLastCol As Integer
Dim varRowCount As Integer
'save the MonthlyLoad book as an object for easy reference
Set WB_MonthlyLoad = ActiveWorkbook
Set WS_MonthSht = ActiveSheet
Set WS_PriceSht = WB_MonthlyLoad.Sheets("Price")
Set WS_RevSht = WB_MonthlyLoad.Sheets("Revenue")
varRowCount = 2
'Open the Project Summary Report and save as object
' - Note right now this just does the single project need to loop through all
'
For Each x In Selection.Cells
If x.Value <> "" Then
Range(x.Address).Hyperlinks(1).Follow NewWindow:=False, AddHistory:=True
Worksheets("% Complete").Select
Set WB_ProjectSummary = ActiveWorkbook
Set WS_PerComSht = WB_ProjectSummary.Worksheets("% Complete")
WB_MonthlyLoad.Activate
varLastCol = WS_PerComSht.Rows(5).Find(What:="Total", LookIn:=xlFormulas).Column - 2
WS_PriceSht.Cells(varRowCount, 1).Value = WS_PerComSht.Cells(7, 1).Value
WS_PerComSht.Range(WS_PerComSht.Cells(8, 4), WS_PerComSht.Cells(8, varLastCol)).Copy
WS_PriceSht.Cells(varRowCount, 2).PasteSpecial Paste:=xlPasteValues
WS_RevSht.Cells(varRowCount, 1).Value = WS_PerComSht.Cells(7, 1).Value
WS_PerComSht.Range(WS_PerComSht.Cells(41, 4), WS_PerComSht.Cells(41, varLastCol)).Copy
WS_RevSht.Cells(varRowCount, 2).PasteSpecial Paste:=xlPasteValues
varRowCount = varRowCount + 1
End If
MHSDate:
WB_ProjectSummary.Close savechanges:=False
MHSLink:
Next x
Exit Sub
'==========================================================================================
MHSErrorHandler:
MsgBox (Err.Description & " - " & Err.Number & x.Address)
If Err.Description = "Cannot open the specified file." Then
Err.Clear
Resume MHSLink
End If
If Err.Number = 91 Then
Err.Clear
WS_MonthSht.Cells(x.Row, 6).Value = "On % Comp, Couldn't find Total Column"
Resume MHSDate
End If
'===============================================================================================
End Sub
Anyone have any ideas