PDA

View Full Version : VBA not on proper ActiveSheet



s.schwantes
01-13-2015, 02:35 PM
First, a little context; I have a calculator that is being cloned (copied) and placed w/in or outside a range. Within the macro for that event, I have embedded another sub which copies a named range (a summary table for mgmt reporting purposes) and copies that range either to RR 1 Summary and/or RR2 Detail, based on the same DV cell B14, which is either Yes (consolidate) or No (do not consolidate). For the reporting piece, if NO, the range should be copied onto both RR1 and RR2 sheets, if YES, then copy range only to RR2 - Detail sheet.

My approach was to break the reporting subs into 3 separate macros and then I embedded the first macro - which calls the second macro - into the first sub which handles the copy rename functionality for the calculator sheet. As 3 separate subs ... I think it was working fine - but when I embedded now the it works fine for the RR1 report, i.e., it links to the renamed target sheet (the one that was the calculator but has now been renamed as a newly priced product). However, on the 2nd report sheet - detail, it ends up linking back to the Calculator sheet. It needs to link back to the target sheet . . . not sure where, but somehow VBA is thinking Calculator must be the ActiveSheet?

Here's the code:


Public Sub CopyRenameSheet()
Application.DisplayAlerts = False
Application.ScreenUpdating = False
'Sets logic to delete FormControl Button

Dim WB As Workbook
Dim oButton As Button
Dim iIndex As Long
Set WB = ThisWorkbook
With WB
'Sets logic to delete FormControl Button
With .Sheets("Calculator")
iIndex = .Buttons(Application.Caller).Index
'Sets logic to end sub based on DV in cell B15
If Range("B15") = "Invalid Inputs" Then
MsgBox ("Invalid Inputs")
Exit Sub
End If
'Determines where to copy Calculator sheet w/in workbook
If .Range("$B$14") = "Yes" Then
.Copy Before:=Sheets("Consol End")
Else
.Copy Before:=Sheets("Consol Start")
End If

End With
'Renames copied Calculator sheet to new product name
With ActiveSheet
.Name = Range("$B$11").Value & " " & Range("$B$12").Value & " " & Range("$B$13").Value & " " & Range("$B$14").Value
Range("B1:C1").Select

'Sets range at top of current sheet to reflect new product name
ActiveCell.FormulaR1C1 = _
"=CONCATENATE(R[10]C,"" "",R[11]C,"" "",R[12]C,"" "",R[13]C)"
Range("B2").Select
'Follow up to logic to delete FormControl Button
Set oButton = .Buttons(iIndex)
oButton.Delete
'Copies Reporting Range and pastes into Rankin Report 1 or 2 based on DV in B14
If .Range("$B$14") = "No" Then
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Application.Goto Reference:="RR_Table_Copy"
Selection.Copy
Sheets("Rankin Report 1 - Summary").Select
Columns("E:F").Select
Selection.Insert Shift:=xlToRight
Range("E1:F76").Select
ActiveSheet.Paste Link:=True
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Range("F5").Select
Selection.ClearContents
Range("F8").Select
Selection.ClearContents
Cells.Select
Cells.EntireColumn.AutoFit
Range("A1").Select
Application.Run ("Macro2")
Else: Application.Run ("Macro3")
End If
End With
End With
End Sub

Sub Macro2()

Application.DisplayAlerts = False
Application.ScreenUpdating = False
Application.Goto Reference:="RR_Table_Copy"
Selection.Copy
Sheets("Rankin Report 2 - Detail").Select
Columns("C:D").Select
Selection.Insert Shift:=xlToRight
Range("C1:D76").Select
ActiveSheet.Paste Link:=True
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Range("D1").Select
Application.CutCopyMode = False
Selection.ClearContents
Range("D5").Select
Selection.ClearContents
Range("D8").Select
Selection.ClearContents
Cells.Select
Cells.EntireColumn.AutoFit
Range("A1").Select
End Sub
Sub Macro3()
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Application.Goto Reference:="RR_Table_Copy"
Selection.Copy
Sheets("Rankin Report 2 - Detail").Select
Columns("C:D").Select
Selection.Insert Shift:=xlToRight
Range("C1:D76").Select
ActiveSheet.Paste Link:=True
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Range("D1").Select
Application.CutCopyMode = False
Selection.ClearContents
Range("D5").Select
Selection.ClearContents
Range("D8").Select
Selection.ClearContents
Cells.Select
Cells.EntireColumn.AutoFit
Range("A1").Select
End Sub


Can anyone see where this is breaking down? Not that it's erring out, it's just not linking from the right sheet. Thanks in advance!

Steve

ValerieT
01-14-2015, 02:46 AM
Hello
Not sure I understand exactly what you want/need but not sure also your approach is the best? Did you made a mistake while copiying the code? Macro2 and 3 look identical to me?

Aussiebear
01-14-2015, 03:51 AM
Not sure if this works


Public Sub CopyRenameSheet() Dim WB As Workbook
Dim oButton As Button
Dim iIndex As Long
Set WB = ThisWorkbook
With WB
Application.DisplayAlerts = False
Application.ScreenUpdating = False
'Sets logic to delete FormControl Button
With .Sheets("Calculator")
iIndex = .Buttons(Application.Caller).Index
'Sets logic to end sub based on DV in cell B15
If Range("B15") = "Invalid Inputs" Then
MsgBox ("Invalid Inputs")
Exit Sub
End If
'Determines where to copy Calculator sheet w/in workbook
If .Range("$B$14") = "Yes" Then
.Copy Before:=Sheets("Consol End")
Else
.Copy Before:=Sheets("Consol Start")
End If
End With
'Renames copied Calculator sheet to new product name
With ActiveSheet
.Name = Range("$B$11").Value & " " & Range("$B$12").Value & " " & Range("$B$13").Value & " " & Range("$B$14").Value
'Sets range at top of current sheet to reflect new product name
Range("B1:C1").FormulaR1C1 = _
"=CONCATENATE(R[10]C,"" "",R[11]C,"" "",R[12]C,"" "",R[13]C)"
'Follow up to logic to delete FormControl Button
With Range("B2")
Set oButton = .Buttons(iIndex)
oButton.Delete
End With
'Copies Reporting Range and pastes into Rankin Report 1 or 2 based on DV in B14
If Range("$B$14").Value = "No" Then
Application.Goto Reference:="RR_Table_Copy"
Selection.Copy
End If

With Sheets("Rankin Report 1 - Summary")
Columns("E:F").Insert Shift:=xlToRight
Range("E1:F76").Paste Link:=True
.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Range("F5, F8").ClearContents
Cells.EntireColumn.AutoFit
Call Macro2
Else
Call Macro3
End With
End With
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

Sub Macro2()

Application.DisplayAlerts = False
Application.ScreenUpdating = False
Application.Goto Reference:=("RR_Table_Copy")
Selection.Copy

With Sheets("Rankin Report 1 - Detail")
Columns("C:D").Insert Shift:=xlToRight
Range("C1:D76").Paste Link:=True
.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Range("D1, D5, D8").ClearContents
Application.CutCopyMode = False
Cells.EntireColumn.AutoFit
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End With
End Sub
Sub Macro3()
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Application.Goto Reference:=("RR_Table_Copy")
Selection.Copy

With Sheets("Rankin Report 2 - Detail")
Columns("C:D").Insert Shift:=xlToRight
Range("C1:D76").Paste Link:=True
.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Range("D1, D5, D8").ClearContents
Application.CutCopyMode = False
Cells.EntireColumn.AutoFit
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End With
End Sub

s.schwantes
01-14-2015, 06:38 AM
Thank you both for responding. I will try running the sample code provided.

Regards,

Steve