Merging two macros together

[Ricky918]

Hello,

I have a macro that will ask the user to input a phone number "without" dashes or dots, the macro stores the number then finds the first empty cell and drops down 2 rows formats it the way I need and puts in the phone number.
Then the macro calls a second macro and passes the phone number along to it. All of this works fine. Then the second macro asks for the source file name and opens the file from the
given location, then searches every cell for the phone number and copies the entire row that has the number in it to another workbook. again all of this works.
What I am looking to do is consolidate the macros into one so I can run the "answer loop" that is in the second macro and not have to reopen the source file as it lives on a network drive.
I have tried and tried to get the code from the macro FonNum to run inside the Extract macro but I can not seem to get it to work. Could someone look at it and point me in the right direction?

Sub FonNum()
 Dim lRow As Integer
 Dim Target As Worksheet
 Dim nPart2 As String
 
 Set Target = Workbooks("Working.xlsm").Worksheets("Results")
 nPart2 = Application.InputBox("Enter the number to search for   EXP:2025551212", Left:=(Application.Width / 2), Top:=(Application.Height / 2), Title:="", Type:=2)

    lRow = Target.Cells(Target.Rows.Count, "A").End(xlUp).Offset(1).Row
    Cells(lRow, 1).Offset(RowOffset:=2).Select
    ActiveCell.NumberFormat = "###""-""###""-""####"
    ActiveCell.Value = nPart2
  
Call Extract(nPart2)
End Sub

Sub Extract(ByVal nPart2 As String)

On Error GoTo ErrorHandler

    Dim c As Range
    Dim j As Integer
    Dim Source As Worksheet
    Dim Target As Worksheet
    Dim LastRow As Long
    Dim pPart1 As String
    Dim pPart2 As String
    Dim nPart1 As String
    ' Dim nPart2 As String     ' located in first macro
    Dim sPath As String
    Dim sName As String
    Dim sNum As String
    Dim answer As Integer

    pPart1 = "C:\Users\*******\Desktop\"
    pPart2 = InputBox("Enter Name of source file")
    
    sPath = pPart1 & pPart2
    
    Workbooks.Open sPath
     
Mark1:
    nPart1 = "+1"
    ' nPart2 = InputBox("Enter the number to search for   EXP:2025551212")    ' located in first macro
    
    sNum = nPart1 & nPart2

    sName = ActiveWorkbook.Name

    Set Source = Workbooks(sName).Worksheets(1)
    Set Target = Workbooks("Working.xlsm").Worksheets("Results")
  
    LastRow = Target.Cells(Target.Rows.Count, "A").End(xlUp).Offset(1).Row
    
    j = LastRow
    
    For Each Source In Worksheets
    
      For Each c In Source.Range("A1:Z65536")
        If c = sNum Then
           Source.Rows(c.Row).Copy Target.Rows(j)
           j = j + 1
        End If
      Next c
    Next
     
    answer = MsgBox("Search for Different Number?", vbQuestion + vbYesNo + vbDefaultButton2, "Search Again?")

     If answer = vbYes Then
      GoTo Mark1
      Else
      GoTo Mark2
      End If
      
Mark2:
     
    Workbooks(sName).Close SaveChanges:=False
     
Exit Sub
ErrorHandler:
    MsgBox "ERROR, Exiting the script"
    Exit Sub
     
End Sub

 

[QuietRiot]

I'm not sure I see the point, but maybe I'm confused..

Sub Extract()

On Error GoTo ErrorHandler

    Dim c As Range
    Dim j As Integer
    Dim lRow As Integer
    Dim Source As Worksheet
    Dim Target As Worksheet
    Dim LastRow As Long
    Dim pPart1 As String
    Dim pPart2 As String
    Dim nPart1 As String
    Dim nPart2 As String
    Dim sPath As String
    Dim sName As String
    Dim sNum As String
    Dim answer As Integer
    
    Set Target = Workbooks("Working.xlsm").Worksheets("Results")
    nPart2 = Application.InputBox("Enter the number to search for   EXP:2025551212", Left:=(Application.Width / 2), Top:=(Application.Height / 2), Title:="", Type:=2)

    lRow = Target.Cells(Target.Rows.Count, "A").End(xlUp).Offset(1).Row
    Cells(lRow, 1).Offset(RowOffset:=2).Select
    ActiveCell.NumberFormat = "###""-""###""-""####"
    ActiveCell.Value = nPart2
    
    pPart1 = "C:\Users\*******\Desktop\"
    pPart2 = InputBox("Enter Name of source file")
    
    sPath = pPart1 & pPart2
    
    Workbooks.Open sPath
     
Mark1:
    nPart1 = "+1"
    
    sNum = nPart1 & nPart2

    sName = ActiveWorkbook.Name

    Set Source = Workbooks(sName).Worksheets(1)
    Set Target = Workbooks("Working.xlsm").Worksheets("Results")
  
    LastRow = Target.Cells(Target.Rows.Count, "A").End(xlUp).Offset(1).Row
    
    j = LastRow
    
    For Each Source In Worksheets
    
      For Each c In Source.Range("A1:Z65536")
        If c = sNum Then
           Source.Rows(c.Row).Copy Target.Rows(j)
           j = j + 1
        End If
      Next c
    Next
     
    answer = MsgBox("Search for Different Number?", vbQuestion + vbYesNo + vbDefaultButton2, "Search Again?")

     If answer = vbYes Then
      GoTo Mark1
      Else
      GoTo Mark2
      End If
      
Mark2:
     
    Workbooks(sName).Close SaveChanges:=False
     
Exit Sub
ErrorHandler:
    MsgBox "ERROR, Exiting the script"
    Exit Sub
     
End Sub