slight change to an existing routine has created problems

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

If B14 can only contain Yes or No and nothing else then this shorter code might do what you want:

Code:

---

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:

Code:

---

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

---

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