s.schwantes
01-23-2015, 08:30 AM
In order to implement some formatting changes the I modified an existing fully functional sub. But, now I have a new issue: If "no", works fine, but if "yes", it then copies the range to both the RR2 tab and the previously active sheet (which gets copied and renamed as a new ws as part of another sub which then calls "Build Extract" sub below).
Sub Build_Extract()
Dim strShName As String
Application.DisplayAlerts = False
Application.ScreenUpdating = False
strShName = ActiveSheet.Name
If UCase(ActiveSheet.Range("B14")) = "NO" Then
Worksheets(strShName).Range("RR_Table_Copy").Copy
With Sheets("Rankin Report 1 - Summary")
.Range("E1").Insert Shift:=xlToRight
.Activate: .Range("E1").Activate
.Paste Link:=True
.Range("F1,F5,F8").ClearContents
.Cells.EntireColumn.AutoFit
.Range("A1").Activate
End With
Worksheets(strShName).Range("RR_Table_Copy").Copy
With Sheets("Rankin Report 2 - Detail")
.Range("C1").Insert Shift:=xlToRight
.Activate: .Range("C1").Activate
.Paste Link:=True
.Range("D1,D5,D8").ClearContents
.Cells.EntireColumn.AutoFit
.Range("A1").Activate
End With
ElseIf UCase(ActiveSheet.Range("B14")) = "YES" Then
Worksheets(strShName).Range("RR_Table_Copy").Copy
With Sheets("Rankin Report 2 - Detail")
.Range("C1").Insert Shift:=xlToRight
.Activate: .Range("C1").Activate
.Paste Link:=True
.Range("D5,D8").ClearContents
.Cells.EntireColumn.AutoFit
.Range("A1").Activate
End With
End If
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
And here's the modified version:
Sub Build_Extract()
Dim strShName As String
Application.DisplayAlerts = False
Application.ScreenUpdating = False
strShName = ActiveSheet.Name
If UCase(ActiveSheet.Range("B14")) = "NO" Then
Worksheets(strShName).Range("RR_Table_Copy").Copy
With Sheets("Rankin Report 1 - Summary").Activate
.Range("E1").Insert Shift:=xlToRight
.Activate: .Range("E1").Activate
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
.Paste Link:=True
.Cells.EntireColumn.AutoFit
.Range("A1").Activate
End With
Worksheets(strShName).Range("RR_Table_Copy").Copy
With Sheets("Rankin Report 2 - Detail").Activate
Range("E1").Insert Shift:=xlToRight
.Activate: .Range("E1").Activate
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
Paste Link:=True
Cells.EntireColumn.AutoFit
Range("A1").Activate
End With
ElseIf UCase(ActiveSheet.Range("B14")) = "YES" Then
Worksheets(strShName).Range("RR_Table_Copy").Copy
With Sheets("Rankin Report 2 - Detail").Activate
.Range("E1").Insert Shift:=xlToRight
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
.Activate: .Range("E1").Activate
.Paste Link:=True
.Cells.EntireColumn.AutoFit
Range("A1").Activate
End With
End If
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
Please advise if you see any glaring syntax issues or a reason why this is breaking down ...
Thanks in advance!
Steve
Sub Build_Extract()
Dim strShName As String
Application.DisplayAlerts = False
Application.ScreenUpdating = False
strShName = ActiveSheet.Name
If UCase(ActiveSheet.Range("B14")) = "NO" Then
Worksheets(strShName).Range("RR_Table_Copy").Copy
With Sheets("Rankin Report 1 - Summary")
.Range("E1").Insert Shift:=xlToRight
.Activate: .Range("E1").Activate
.Paste Link:=True
.Range("F1,F5,F8").ClearContents
.Cells.EntireColumn.AutoFit
.Range("A1").Activate
End With
Worksheets(strShName).Range("RR_Table_Copy").Copy
With Sheets("Rankin Report 2 - Detail")
.Range("C1").Insert Shift:=xlToRight
.Activate: .Range("C1").Activate
.Paste Link:=True
.Range("D1,D5,D8").ClearContents
.Cells.EntireColumn.AutoFit
.Range("A1").Activate
End With
ElseIf UCase(ActiveSheet.Range("B14")) = "YES" Then
Worksheets(strShName).Range("RR_Table_Copy").Copy
With Sheets("Rankin Report 2 - Detail")
.Range("C1").Insert Shift:=xlToRight
.Activate: .Range("C1").Activate
.Paste Link:=True
.Range("D5,D8").ClearContents
.Cells.EntireColumn.AutoFit
.Range("A1").Activate
End With
End If
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
And here's the modified version:
Sub Build_Extract()
Dim strShName As String
Application.DisplayAlerts = False
Application.ScreenUpdating = False
strShName = ActiveSheet.Name
If UCase(ActiveSheet.Range("B14")) = "NO" Then
Worksheets(strShName).Range("RR_Table_Copy").Copy
With Sheets("Rankin Report 1 - Summary").Activate
.Range("E1").Insert Shift:=xlToRight
.Activate: .Range("E1").Activate
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
.Paste Link:=True
.Cells.EntireColumn.AutoFit
.Range("A1").Activate
End With
Worksheets(strShName).Range("RR_Table_Copy").Copy
With Sheets("Rankin Report 2 - Detail").Activate
Range("E1").Insert Shift:=xlToRight
.Activate: .Range("E1").Activate
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
Paste Link:=True
Cells.EntireColumn.AutoFit
Range("A1").Activate
End With
ElseIf UCase(ActiveSheet.Range("B14")) = "YES" Then
Worksheets(strShName).Range("RR_Table_Copy").Copy
With Sheets("Rankin Report 2 - Detail").Activate
.Range("E1").Insert Shift:=xlToRight
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
.Activate: .Range("E1").Activate
.Paste Link:=True
.Cells.EntireColumn.AutoFit
Range("A1").Activate
End With
End If
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
Please advise if you see any glaring syntax issues or a reason why this is breaking down ...
Thanks in advance!
Steve