Const miOBJNUM_COLUMN As Integer = 4
'
 
Sub AttachFile()
    Dim fn, iName
    Dim lFreeNum As Long
    Dim wksF As Worksheet
    Dim lNextRow As Long
    
    'reference to the worksheet with 'Offering Attachments' data
    Set wksF = ThisWorkbook.Worksheets("WorksheetF")
    'The next row to fill in for the new file, using column 1 last non-empty cell
    lNextRow = wksF.Cells(wksF.Rows.Count, 1).End(xlUp).Row + 1
    
    iName = ThisWorkbook.Name
    Sheets("Admin").Range("Z3000").Value = iName
    iNum = ExtractNumber(Sheets("Admin").Range("Z3000"), False, False)
    Application.ScreenUpdating = False
    fn = Application.GetOpenFilename("All Files,*.*", Title:=" Find file to insert")
    If FileLen(fn) > 2000000 Then
        MsgBox "File exceeds size limit of 2MB, please choose a smaller file!"
        GoTo TheEnd
    End If
    If fn = False Then
        MsgBox "No file has been selected, please try again!"
    Else
        'Get a number for the OLEobject that has not been used, Maximum + 1
        With wksF
            lFreeNum = _
                Application.WorksheetFunction.Max( _
                .Range(.Cells(2, miOBJNUM_COLUMN), .Cells(.Rows.Count, miOBJNUM_COLUMN).End(xlUp)) _
                ) + 1
            'enter the new number in the OLEobjectNumber column
            .Cells(lNextRow, miOBJNUM_COLUMN).Value = lFreeNum
        End With
        
        
        Sheets("Log File").Select
            sFullFileName = fn
            iPos = InStrRev(sFullFileName, "\", -1, vbTextCompare)
            sFileName = iNum & "-" & Right(sFullFileName, Len(sFullFileName) - iPos)
        'Add the file to the Oleobjects collection and assign the name to the OLEobject
        ActiveSheet.OLEObjects.Add(Filename:=fn, Link:=False, DisplayAsIcon:=True, _
            IconFileName:=sFileName, IconIndex:=9, IconLabel:=sFileName, Left:=50, _
            Top:=5, Width:=50, Height:=40).Name = "myObj" & lFreeNum
            
        Sheets("Offering ADD").Select
        Sheets("Offering ADD").Unprotect
        Range("OffAttach").Value = sFileName
        Sheets("Offering ADD").Protect
        Range("A8").Select
    End If
TheEnd:
    Application.ScreenUpdating = True
End Sub

Select all