Macro to run a specific block of code inside another macro - excel

Question

I have four or five macro's each copying and pasting different subsets of data (all defined as ranges) from one tab to another tab. Occasionally someone may need to change some of the pasted data or rather portions of this.
Each of these macro's contains defined points I can goto. BUT if I needed to get to these points from another macro without running the bit before the goto point in the target macro - how can I do this.
I can call or application.run the second macro, but I need only run a part of it, not the whole thing.
I am a bit stuck.
Here is the part of the code which defines the goto point in one of the target macro's.
Grade:
Grades = Application.InputBox("Which Grade chemistry do you wish to load & Check against" & vbLf & vbLf & "1. S355 J2H" & vbLf & vbLf & "2. S355NH" & vbLf & vbLf & "3. S355NLH" & vbLf & vbLf, "Select which option to load")
Select Case Grades
Case 1
Ans = MsgBox("You have selected S355J2H is this correct?", vbYesNo) ' allows a loop if you have made a mistake and will take you back to the selection option
If Ans = vbNo Then GoTo Grade Else:
rng8.Copy: rng7.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ws.Activate
Columns("BC:BD").Select
With Selection.Font
.ThemeColor = xlThemeColorDark1
.TintAndShade = 0
End With
Case 2
Ans = MsgBox("You have selected S355NH is this correct?", vbYesNo) ' allows a loop if you have made a mistake and will take you back to the selection option
If Ans = vbNo Then GoTo Grade Else:
rng8a.Copy: rng7.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ws.Activate
Columns("BC:BD").Select
With Selection.Font
.ThemeColor = xlThemeColorDark1
.TintAndShade = 0
End With
Case 3
Ans = MsgBox("You have selected S355NLH is this correct?", vbYesNo) ' allows a loop if you have made a mistake and will take you back to the selection option
If Ans = vbNo Then GoTo Grade Else:
rng8b.Copy: rng7.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ws.Activate
Columns("BC:BD").Select
With Selection.Font
.ThemeColor = xlThemeColorDark1
.TintAndShade = 0
End With
Case Else ' this is where no input or an alternative input is done, it will exit the subroutine
dummy = MsgBox("wrong input please try again", vbCritical)
Exit Sub
End Select
There is a similar code before this step, which I do NOT want to run and I would ideally like to not repeat this code and others from the target macro's in a separate macro, and call this new macro. When I need to update the information it means updating in multiple places instead one just the one or two maximum.

Answer 1

As BigBen suggested, you need to refactor your code. Copy the below code in a Module
Option Explicit
Public rRng8 As Range, rRng8a As Range, rRng8b As Range
Sub CopyRange(rCopyToRng As Range)
Dim iGrade As Long, iAns As Long, iTryAgain As Long
' Set Default Values
iAns = vbNo
iTryAgain = vbYes
' Loop to copy the correct range
Do While iAns <> vbYes And iTryAgain <> vbNo
' Get grade
iGrade = Application.InputBox("Which Grade chemistry do you wish to load & Check against" & vbLf & vbLf & "1. S355 J2H" & vbLf & vbLf & "2. S355NH" & vbLf & vbLf & "3. S355NLH" & vbLf & vbLf, "Select which option to load", , , , , , 1)
' Case to select the correct range to copy
Select Case iGrade
Case 1
iAns = MsgBox("You have selected S355J2H is this correct?", vbYesNo)
If iAns = vbYes Then CopyRangeHelper rCopyToRng, rRng8
Case 2
iAns = MsgBox("You have selected S355NH is this correct?", vbYesNo)
If iAns = vbYes Then CopyRangeHelper rCopyToRng, rRng8a
Case 3
iAns = MsgBox("You have selected S355NLH is this correct?", vbYesNo)
If iAns = vbYes Then CopyRangeHelper rCopyToRng, rRng8b
Case Else
' If the user entere incorrect number, ask if the want to try again
iTryAgain = MsgBox("Wrong input. Do you want to try again?", vbQuestion + vbYesNo)
End Select
Loop
End Sub
Sub CopyRangeHelper(rCopyToRange As Range, rRngToCopy As Range)
' Copy range
rRngToCopy.Copy: rCopyToRange.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
' Set range format
With rCopyToRange
.Interior.ThemeColor = xlThemeColorDark1
.Interior.TintAndShade = 0
End With
End Sub
NOTE: You don't need to use Select or Activate. You just reference what you need to work with
How to use this:
Below is a sample UDF that calls CopuRange UDF to perform the action
Sub TestThis()
Dim oWS As Worksheet: Set oWS = ThisWorkbook.Worksheets("Sheet3") ' Change sheet reference
Set rRng8 = oWS.Range("A1:A16") ' Set ranges as required
Set rRng8a = oWS.Range("B1:B16")
Set rRng8b = oWS.Range("C1:C16")
CopyRange ThisWorkbook.Worksheets("Sheet4").Range("A1:A16") ' Change sheet reference and range
End Sub