Redundant coding perhaps?

[tljenkin]

Hi All

I have the following code below. Do I really need to paste the same actions twice depending on the choice of the user? Is there a way to loop if the user says "NO" back to the same actions in the first part? I have marked the points below with comments in capital letters.

Please help

Thanks


Sub UpdateDatabase()

Dim FileToBeOpened As Variant, File As Variant, Ard As Workbook, Wrr As Workbook
Set Ard = ThisWorkbook ' or Actuals repository current version presently open

Application.ScreenUpdating = False

Dim Response As Integer
Response = MsgBox(prompt:="Is the most recent weekly Redress report open?", Buttons:=vbYesNo)
If Response = vbYes Then
On Error GoTo 0


For Each Wrr In Application.Workbooks
If Wrr.Name Like "Week*" Then Wrr.Activate
Next Wrr
Set Wrr = ActiveWorkbook

' START OF ACTIONS, THIS SHOULD BE THE START OF THE LOOP

Wrr.Activate
Sheets("Tracking Report").Select
Application.Goto Reference:="R5C2:R500C38"
Selection.Copy

'Define the final row
Ard.Activate
Sheet13.Select
FinalRow = Cells(Rows.Count, 1).End(xlUp).Row
NextRow = FinalRow + 1
Cells(NextRow, 2).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False



Calculate
ActiveWorkbook.RefreshAll
Sheet22.Activate
Wrr.Close (False)
Application.ScreenUpdating = True

End If


If Response = vbNo Then


On Error GoTo 0
FileToBeOpened = Application.GetOpenFilename(FileFilter:="All Excel Files (*.xls*), *.xls*", Title:="Where is the most recent weekly Redress file?", MultiSelect:=False)
Application.ScreenUpdating = False

' Exit if user exits dialog
If FileToBeOpened = False Then Exit Sub

' Open file (Wrr), copy most recent weekly redress data to the Actuals Repository
Set Wrr = Workbooks.Open(FileToBeOpened)

'WOULD LIKE TO LOOP THIS TO THE SAME POINT ABOVE INSTEAD OF PASTING THE SAME THING BELOW

Wrr.Activate
Sheets("Tracking Report").Select
Application.Goto Reference:="R5C2:R500C38"
Selection.Copy

'Define the final row
Ard.Activate
Sheet13.Select
FinalRow = Cells(Rows.Count, 1).End(xlUp).Row
NextRow = FinalRow + 1
Cells(NextRow, 2).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False



Calculate
ActiveWorkbook.RefreshAll
Wrr.Close (False)
Application.ScreenUpdating = True

End If

End Sub

 

[tljenkin]

Perhaps I was not clear even, in summary I want to be able to goto a particular point in a code and run the actions from there but I dont want the code to kep doing this in an endless loop. Just one time

Thanks