PDA

View Full Version : [SOLVED:] slight change to an existing routine has created problems



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

p45cal
01-23-2015, 10:46 AM
If B14 can only contain Yes or No and nothing else then this shorter code might do what you want:
Sub Build_Extract()
Dim strShName As String
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Set SceSht = ActiveSheet
If UCase(SceSht.Range("B14")) = "NO" Then
SceSht.Range("RR_Table_Copy").Copy
With Sheets("Rankin Report 1 - Summary")
.Activate
.Range("E1").Insert Shift:=xlToRight
.Range("E1").PasteSpecial Paste:=xlPasteValuesAndNumberFormats
.Paste Link:=True
.Cells.EntireColumn.AutoFit
.Range("A1").Activate
End With
End If
SceSht.Range("RR_Table_Copy").Copy
With Sheets("Rankin Report 2 - Detail")
.Activate
.Range("E1").Insert Shift:=xlToRight
.Range("E1").PasteSpecial Paste:=xlPasteValuesAndNumberFormats
.Paste Link:=True
.Cells.EntireColumn.AutoFit
.Range("A1").Activate
End With
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
However, if B14 can contain other things then reverting to your If.. ..then.. ..elseif.. statement:
Sub Build_Extract()
Dim strShName As String
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Set SceSht = ActiveSheet
If UCase(SceSht.Range("B14")) = "NO" Then
SceSht.Range("RR_Table_Copy").Copy
With Sheets("Rankin Report 1 - Summary")
.Activate
.Range("E1").Insert Shift:=xlToRight
.Range("E1").PasteSpecial Paste:=xlPasteValuesAndNumberFormats
.Paste Link:=True
.Cells.EntireColumn.AutoFit
.Range("A1").Activate
End With
SceSht.Range("RR_Table_Copy").Copy
With Sheets("Rankin Report 2 - Detail")
.Activate
.Range("E1").Insert Shift:=xlToRight
.Range("E1").PasteSpecial Paste:=xlPasteValuesAndNumberFormats
.Paste Link:=True
.Cells.EntireColumn.AutoFit
.Range("A1").Activate
End With
ElseIf UCase(SceSht.Range("B14")) = "YES" Then
SceSht.Range("RR_Table_Copy").Copy
With Sheets("Rankin Report 2 - Detail")
.Activate
.Range("E1").Insert Shift:=xlToRight
.Range("E1").PasteSpecial Paste:=xlPasteValuesAndNumberFormats
.Paste Link:=True
.Cells.EntireColumn.AutoFit
.Range("A1").Activate
End With
End If
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

s.schwantes
01-23-2015, 11:55 AM
hey p45cal

The DV cell is yes/no only, so your first batch there is the answer I was after. Very elegant solution! Thanks very much!!!

Cheers,

Steve