slight change to an existing routine has created problems

[s.schwantes]

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]

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]

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