Sub Process_Word_File()
 Dim xlApp As Object
 Dim xlbook As Object
 Dim wdDoc As Document
 Dim wdFileName As Variant
 Dim i As Long
 Dim EEname As String, EENumber As String, EEDpt As String, HireDAte As String, AccrualDate As String, HoursWorked As String
 Dim SickHoursAccrued As String, SickHoursTaken As String, VacationHoursAccrued As String, VacationHoursTaken As String
 Dim FormulaPasteArea As Range
 Dim ix As Long
 Dim lrow As Long
 Dim lcol As Long
 
 
 Const LK1 As String = "AccVAC"
 Const SickFactor = "0.03846"
 Const xlUp As Long = -4162
 Const xlDown As Long = -4121
 Const xltoLeft As Long = -4159
 Const xltoRight As Long = -4161
 Const xlPasteValues As Long = -4163
  Const xlValues As Long = -4163
  
  
    wdFileName = BrowseForFile("Select the Word document to process", False)
    If wdFileName = "" Then GoTo lbl_Exit
    Set wdDoc = Documents.Open(wdFileName)
    Delete_Header_first_row
    RemoveSectionBreaks
    DeleteEmptyParas
    wdDoc.Tables(1).Range.Copy

    On Error Resume Next
    Set xlApp = GetObject(, "Excel.Application")
    If Err Then
        Set xlApp = CreateObject("Excel.Application")
    End If
    On Error GoTo 0
    Set xlbook = xlApp.Workbooks.Add
    xlApp.Visible = True

    xlbook.sheets(1).Range("A1").PasteSpecial ("HTML")
    With xlbook.sheets(1).usedrange
        .VerticalAlignment = -4160
        .HorizontalAlignment = -4131
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = -1
        .ShrinkToFit = False
        .ReadingOrder = -5002
        .MergeCells = False
        .Columns.AutoFit
        
    End With
  
    EEname = "=TRIM(LEFT(A1,SEARCH({" & """" & "A   " & """" & ",0,1,2,3,4,5,6,7,8,9},A1)-1))"
    EENumber = "=MID(A1,SEARCH({" & """" & "A   " & """" & ",0,1,2,3,4,5,6,7,8,9},A1)+4,4)"
    EEDpt = "=MID(A1,SEARCH({" & """" & "A   " & """" & ",0,1,2,3,4,5,6,7,8,9},A1)+12,4)"
    HireDAte = "=LEFT(A2,10)"
    AccrualDate = "=MID(A2,SEARCH("" "",A2),LEN(A2)-16)"
    
   
    
   xlbook.sheets(1).Range("B:F").EntireColumn.Insert
   xlbook.sheets(1).Range("B1").Formula = EEname  'Column 2
   xlbook.sheets(1).Range("C1").Formula = EENumber 'Column 3
   xlbook.sheets(1).Range("D1").Formula = EEDpt    'Column 4
   xlbook.sheets(1).Range("E1").Formula = HireDAte 'Column 5
   xlbook.sheets(1).Range("F1").Formula = AccrualDate  'Column 6
   
    xlbook.sheets(1).Range("E1").NumberFormat = "m/d/yyyy"
    xlbook.sheets(1).Range("F1").NumberFormat = "m/d/yyyy"
   
   
    
    HoursWorked = "=IF(LEFT(G1,7)*1=" & SickFactor & " ,0,MID(G1,1,7))"
    SickHoursAccrued = "=MID(g1,16,7)"
    SickHoursTaken = "=MID(g1,24,7)"
    VacationHoursAccrued = "=IF(OR(LEFT(G2,7)*1=3.08,LEFT(G2,7)*1=4.62,LEFT(G2,7)*1=6.16,LEFT(G2,7)*1=7.7),LEFT(G2,7),MID(G2,9,7))"
    VacationHoursTaken = "=Mid(g2, 16, 7)"
   
   xlbook.sheets(1).Range("H:L").EntireColumn.Insert
   xlbook.sheets(1).Range("H1").Formula = HoursWorked  'Column 8
   xlbook.sheets(1).Range("I1").Formula = SickHoursAccrued 'Column 9
   xlbook.sheets(1).Range("J1").Formula = SickHoursTaken 'Column 10
   xlbook.sheets(1).Range("K1").Formula = VacationHoursAccrued 'Colum 11
   xlbook.sheets(1).Range("L1").Formula = VacationHoursTaken 'Column 12
   
   xlbook.sheets(1).Range("N1").Formula = "=LEFT(M1,8)"  'Column 13
   xlbook.sheets(1).Range("O1").Formula = "=MID(M1,10,8)"  'Column 14
   xlbook.sheets(1).Range("P1").Formula = "=RIGHT(M1,8)"   'Column 15
   xlbook.sheets(1).Range("Q1").Formula = "=LEFT(M2,8)"    'Column 16
   xlbook.sheets(1).Range("R1").Formula = "=MID(M2,10,8)"  'Column 17
   xlbook.sheets(1).Range("S1").Formula = "=RIGHT(M2,8)"   'Column 18
   
   'set the size of the range to copy formulas to
    Set FormulaPasteArea = xlbook.sheets(1).Range("A1", xlbook.sheets(1).Range("A65536").End(xlUp)).Row
         
     xlbook.sheets(1).Range("B1:F1").Copy xlbook.sheets(1).FormulaPasteArea.Offset(0, 1)
     xlbook.sheets(1).Range("H1:L1").Copy xlbook.sheets(1).FormulaPasteArea.Offset(0, 7)
     xlbook.sheets(1).Range("N1:S1").Copy xlbook.sheets(1).FormulaPasteArea.Offset(0, 12)
     
     
     'copy entire worksheet and replace formulas with data
       xlbook.sheets(1).Cells.Copy
      xlbook.sheets(1).Range("A1").PasteSpecial Paste:=xlValues
        
   
   ' Delete nonesential lines
   'In column A (1), Look for and remove rows wich contain the following:
     'LK2 = "Group"
     
     With xlbook.sheets(1).Sheet1
        lrow = xlbook.sheets(1).Range("a65536").End(xlUp).Row  'USE COLUMN A TO FIND THE LAST ROW OF DATA
        For ix = lrow To 1 Step -1
         .Cells(ix, 1).Value = LK1
          .Rows(ix).Delete
        Next ix
     End With

     
    'wdDoc.Close 0
lbl_Exit:
    Set xlApp = Nothing
    Set xlbook = Nothing
    Set wdDoc = Nothing
    Exit Sub
End Sub

Dim FormulaPasteArea As Object