PDA

View Full Version : Solved: Subscript Out of Range Error



SherryO
02-16-2006, 01:40 PM
Hi I am trying to call one macro from another. In PopPrep and trying to call CheckWBS, but I get the Subscript Out of Range error in the CheckWBS sub on the Set statements. The file name and sheet names are spelled correctly and you can see they worked fine in the macro before them. Can someone please tell me what I'm doing wrong? I'm beginning to think that perhaps I should find a brick wall to beat my head against. Thank you so much!!!

Sub PopPrep()
Dim WsD As Worksheet 'Destination Worksheet
Dim WsPL As Worksheet
Dim WsDI As Worksheet
Set WsD = Workbooks("BWInProgress.xls").Sheets("Periodic_data")

'****Copy and PasteValues for Find to Work
With WsD
Range("E3").Select
ActiveCell.FormulaR1C1 = "=R[-1]C[-4]"
Range("F3").Select
ActiveCell.FormulaR1C1 = "=R[3]C"
Range("F3").Select
Selection.Copy
Range("G3:CL3").Select
ActiveSheet.Paste
Range("E3").Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.NumberFormat = "General"
Calculate
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
End With

'****Removing unnecessary data (take out when done testing)
Workbooks("BUInProgress.xls").Activate
ActiveWorkbook.Sheets("MonthlyRawData").Select
Columns("J:J").Select
Selection.Delete Shift:=xlToLeft
Columns("H:H").Select
Selection.Delete Shift:=xlToLeft
Columns("C:C").Select
Selection.Delete Shift:=xlToLeft
Sheets("MonthlyRawData").Select
Columns("E:E").Select
Selection.NumberFormat = "General"
ActiveWorkbook.Sheets("ProjectsList").Select
ActiveSheet.PivotTables("PivotTable2").PivotCache.Refresh

Set WsDI = Workbooks("BWInProgress.xls").Sheets("Input_Data")
Set WsPL = Workbooks("BUInProgress.xls").Sheets("ProjectsList")

'****Same Project?
If WsDI.Range("C3") <> WsPL.Range("g2") Then
MsgBox ("The WA numbers do not match. Please try again.")
Exit Sub
End If

'****More than one project
If WsPL.Cells(1, 6) > 1 Then
MsgBox ("You can only upload one budget at a time. " & _
"You have selected more than one. Please try again.")
Exit Sub
End If
'****No WBS Structure
If WsPL.Cells(1, 8) < 2 Then
MsgBox ("The MSProject you have selected does not " & _
"have a valid WBS Structure. Please try again.")
Exit Sub
End If
Set WsPL = Nothing
Set WsD = Nothing
'****Compare WBS and List Tasks to be Added
Call CheckWBS

End Sub
Sub CheckWBS()
Dim WsPL As Worksheet
Dim WsD As Workbook
Dim rngCel As Range 'cell to search for
Dim rngChk As Range 'range to look in
Dim tmpCel As Range 'temp cell
Dim tmpRng As Range 'temp range
Dim cel As Range
Dim LastRow As Long
Set WsPL = Workbooks("BUInProgress").Sheets("ProjectsList")
Set WsD = Workbooks("BWInProgress")
Workbooks("BWInProgress").Sheets("Periodic_Data").Range("a7:a65536").Select
Selection.Copy
Sheets("LastActuals").Select
Range("K2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Selection.Sort Key1:=Range("K2"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortTextAsNumbers
Columns("K:K").Select
Selection.Replace What:="total", Replacement:="", LookAt:=xlWhole, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Workbooks("BUInProgress").Activate
Set rngChk = WsPL.Sheets("projectslist").Range("h5:h500")
For Each rngCel In rngChk
With WsD.Sheets("LastActuals")
Set tmpCel = .Range("K:K").Find(rngCel.Value)
If Not tmpCel Is Nothing Then
Set tmpRng = Range(tmpCel, .Cells(tmpCel.row, 256).End(xlToLeft))
For Each cel In tmpRng
Next cel
Else
rngCel.Cells.Copy Sheets("LastActuals").Range("m65536").End(xlUp).Offset(1)
End If
End With
Next rngCel
If WsPL.Range("M1") > 0 Then
MsgBox "The WBS Structure in your MSProject Plan and Merlin do not Match."
''change to userform and code for emails
Exit Sub
End If
End Sub

lucas
02-16-2006, 02:53 PM
Hi Sherry,
It would be easier for me to understand your problem if you would upload a sanitized version of your workbook.....
go to manage attachments at the bottom of the screen after you click on post reply...

XLGibbs
02-16-2006, 03:12 PM
This is a more sanitized version of the same code, unchanged..simply to remove the selects and unecessary content...

General rule of thumb on subscript errors with a set statement like that is that there is a spelling error in one of the names..



Sub CheckWBS()
Dim WsPL As Worksheet
Dim WsD As Workbook
Dim rngCel As Range 'cell to search for
Dim rngChk As Range 'range to look in
Dim tmpCel As Range 'temp cell
Dim tmpRng As Range 'temp range
Dim cel As Range
Dim LastRow As Long

Set WsPL = Workbooks("BUInProgress").Sheets("ProjectsList")
Set WsD = Workbooks("BWInProgress")

Workbooks("BWInProgress").Sheets("Periodic_Data").Range("a7:a65536").Copy
Sheets("LastActuals").Range("K2").PasteSpecial xlPasteValues
Sheets("LastActuals").Range("K2").Resize(UsedRange).Select
Selection.Sort Key1:=Range("K2"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortTextAsNumbers
Columns("K:K").Replace What:="total", Replacement:="", LookAt:=xlWhole, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False

Workbooks("BUInProgress").Activate

Set rngChk = WsPL.Sheets("projectslist").Range("h5:h500")
For Each rngCel In rngChk
With WsD.Sheets("LastActuals")
Set tmpCel = .Range("K:K").Find(rngCel.Value)
If Not tmpCel Is Nothing Then
Set tmpRng = Range(tmpCel, .Cells(tmpCel.Row, 256).End(xlToLeft))
For Each cel In tmpRng
Next cel
Else
rngCel.Cells.Copy Sheets("LastActuals").Range("m65536").End(xlUp).Offset(1)
End If
End With
Next rngCel
If WsPL.Range("M1") > 0 Then
MsgBox "The WBS Structure in your MSProject Plan and Merlin do not Match."
''change to userform and code for emails
Exit Sub
End If
End Sub

SherryO
02-21-2006, 06:49 AM
You are too cool. Thank you. I'll give it a shot. Sherry

SherryO
02-21-2006, 07:11 AM
I get the message Compile Error, Method or Data Member Not Found on the following line, on Sheets in particular. This is part of the same project you already helped me with. Is it possible that the code from the previous person, which I am running before this macro, could be causing a conflict? I believe I have another conflict elsewhere which I am trying to resolve. Thank you so much for your help.

Set rngChk = WsPL.Sheets("projectslist").Range("h5:h500")

XLGibbs
02-21-2006, 12:28 PM
You already identify which sheet WsPL refers to in a set statement above that...so you only need

St rngChk = WsPL.Range("h5:h500")

The error is happening because you are trying to identify Sheets as a member of the Worksheet object....which won't work. Once you set WsPL = to a worksheet, it represents an object within the Sheets collection so the statement I have above is the same as

Set rngChk = Workbooks("BUInProgress").Sheets("ProjectLists").Range("H5:H500")

since WsPL = Workbooks("BUInProgress").Sheets("ProjectLists").

SherryO
02-21-2006, 12:32 PM
You are absolutely right. Not only that, but the dork that I am forgot the .xls extension too. Thanks again! So many times another set of eyes can see things that get missed when a person gets too close. I swear this project is going to drive me to drink!:>

Killian
02-22-2006, 04:39 AM
I swear this project is going to drive me to drink!:>
So have a party when it's done!

:drink: :dance: :drunkard:

SherryO
02-22-2006, 06:44 AM
You bet your sweet bippy I will!!! :>

XLGibbs
02-22-2006, 07:16 AM
It already drove me to drink Sherry, and it isn't even my project. Sorry, should have spotted the missing .xls