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!!!
[VBA]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[/VBA]
Reply With Quote
Originally Posted by SherryO
