Need help merging some code

[bamaisgreat]

Below I have 2 parts of code I need added to the large module below. I have tried this several times an cannot seem to get it correct.
I no this is a little lengthy task but any help would be great

Sub save_file()
Dim wb As Workbook

Application.ScreenUpdating = False
Application.DisplayAlerts = False

With ThisWorkbook.Worksheets(1)
    .Cells.Copy
    Set wb = Workbooks.Add
    wb.Worksheets(1).Range("A1").PasteSpecial (xlPasteValues)
    wb.SaveAs Filename:=[B]"B:\Archives\ReadonlyMasterList.xls"[/B], ReadOnlyRecommended:=True
    wb.Close
End With

Application.ScreenUpdating = True
Application.DisplayAlerts = True

This is just to create another copy in a different location as read-only.

Sub delete_empty_rows()

Application.ScreenUpdating = False

Range("A1").Select

For i = 1 To ActiveSheet.UsedRange.Rows.Count

    If Application.CountA(ActiveCell.EntireRow) = 0 Then
    
        ActiveCell.EntireRow.Delete
            Else
        ActiveCell.Offset(1, 0).Select
        End If
    Next i
End Sub

This code is just to get rid of the empty row in the Master Archive.xls workbook

Main Module

Sub FINALIZED_BY_QC_job()
Dim newFileName As String
Dim appendtext As String
Dim rngfil As Range, cell As Range
Dim NR As Long, I As Long
If UCase(InputBox("Enter Password")) <> "1288" Then Exit Sub
With ActiveSheet
.Unprotect Password:="1288"
With .Range("J24").Interior
.Pattern = xlSolid
.PatternColorIndex = 1
.Color = 255
.TintAndShade = 0
.PatternTintAndShade = 0
End With
appendtext = "             -FINAL"
.Range("J24").FormulaR1C1 = appendtext
With ActiveWorkbook
    oldFileName = .FullName
    newFileName = Left(.FullName, InStrRev(.FullName, ".xls") - 1) _
        & appendtext
    .SaveAs Filename:=newFileName
End With
Kill oldFileName
ActiveWorkbook.Save
Set ws1 = ActiveWorkbook.Sheets("JOB CUTTING FORM")
SourcePath = ActiveWorkbook.Path
SourceFile = Left(ActiveWorkbook.name, InStrRev(ActiveWorkbook.name, ".xls") - 1) & "-PA.xls"
 
    ActiveSheet.Shapes.Range(Array("Button 192")).Select
    Selection.OnAction = "PURCH_COMMENTS_JOB"
Range("$H$1:$K$1").Locked = True
    
    Cells.Select
    Selection.Locked = True
    Range("W4:W22").Select
    Selection.Locked = False
    Selection.FormulaHidden = False
    ActiveSheet.EnableSelection = xlUnlockedCells
    Range("W4").Select
    
Set rngfil = Range("B4,C4,H4,J4,T4,U4") 'first row of data to be processed
For r = 0 To 18 'row offset variable
EmptyRowCheck = ""
For Each cell In rngfil.Offset(r, 0) 'Concat values of cells in rngfil offset
EmptyRowCheck = EmptyRowCheck & cell
Next cell
If EmptyRowCheck = "" Then GoTo FoundEmptyRow ' if "" empty row of rngfil cells found so stop putting -
For Each cell In rngfil.Offset(r, 0) 'otherwise put - in any empty cell
If cell.Value = vbNullString Then
cell.Value = "-"
End If
Next cell
Next r
FoundEmptyRow: 'stop putting -
' Archive values to ....
Filename = "H:\Burney Table\CUTTING FORMS (Protected by QC)\Archive\Master Archive.xls"
Workbooks.Open (Filename)
With ActiveSheet
.Unprotect Password:="master"
End With
HypoAddress = SourcePath & "\" & SourceFile
NR = Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Row + 1
For I = 0 To 18
Sheets("Sheet1").Range("A" & NR + I).Value = ws1.Range("B" & I + 4).Value
'Sheets("Sheet1").Range("B" & NR + I).Value = ws1.Range("B" & I + 4).Value
Sheets("Sheet1").Range("C" & NR + I).Value = ws1.Range("C" & I + 4).Value
Sheets("Sheet1").Range("D" & NR + I).Value = ws1.Range("H" & I + 4).Value
Sheets("Sheet1").Range("E" & NR + I).Value = ws1.Range("J" & I + 4).Value
Sheets("Sheet1").Range("F" & NR + I).Value = ws1.Range("T" & I + 4).Value
Sheets("Sheet1").Range("G" & NR + I).Value = ws1.Range("U" & I + 4).Value
'Sheets("Sheet1").Range("H" & NR + I).Value = ws1.Range("U" & I + 4).Value

HypoSubAddress = "'" & ws1.name & "'" & "!" & ws1.Range("H" & I + 4).Address
    If Not ws1.Range("H" & I + 4).Value = "" Then
    Sheets("Sheet1").Hyperlinks.Add Anchor:=Sheets("Sheet1").Range("H" & NR + I), Address:= _
        HypoAddress, SubAddress:= _
        HypoSubAddress, TextToDisplay:= _
        "Link To...."
    End If

Next I
ActiveWorkbook.Save
With ActiveSheet
.Unprotect Password:="master"
End With
ActiveWorkbook.Save
ActiveWorkbook.Close
.Protect Password:="1288", DrawingObjects:=True, Contents:=True, Scenarios:=True
End With
ThisWorkbook.Save
Application.Quit
End Sub

 

[DeBeuz]

Hi,

The first piece of code is lacking the "End Sub" statement, but that might be a copy error.
What did you try?
Insert the code between the "Sub" and "End Sub" statements in the large piece, or did you append both pieces behind the "End Sub" of the last piece.
In the latter you can use the new subs by calling them at the correct spots in the large piece (FINALIZED_BY_QC_job).
What errors do you encounter?

Paul