worksheetfunction not working when controlling excel from word.

gbrew584 · #1 05-22-2016, 08:26 PM

Hi all, I've been looking at the internet for hours looking for a solution to my problem but I'm not having any luck. In the past I have asked the good people on this forum for help and have gotten fantastic replies that have help my protect along. I'm hoping someone may be able to take the time to look at the code I have so far and let me know why it is giving me errors. The error is "Method or Data Member not found" when it reaches the section of 'find the last row in the worksheet, and 'fill the worksheet with the ee name and ee number.

I've tried referencing the object, removing "worksheetfunction" , substituting Application with xlapp etc... but I just don't know enough about vba to find the solution to the problem.

If someone could give me a pointer or two, and tell me where I am going wrong I would appreciate it.

I have posted the code I have so far, please note there a lot of extra lines of text because I'm using code from other projects i have created and I'm trying to mesh them together. once i have the edited the code and have it working i will delete the unneeded lines,

Code:

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 RegularHours As String, OtherHours As String, HoursCode As String, EEName As String, EENumber As String
 Dim DeductionLabels As String
 Dim FormulaPasteArea As Object, FormulaPasteAreaYTD As Object
 Dim ix As Long, ix2 As Long
 Dim LastRow As Long, lrow2 As Long
 Dim lcol As Long
 Dim Rcount As Long
 
 
  Const LK1 As String = "AccVAC"
  Const LK2 As String = "Delete"
  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
  Const xldelimited As Long = 1
  Const xlDoubleQuote As Long = 1
  Const xlCellTypeFormulas = -4123
  Const xlpart = 2
  Const xlbyrows = 1
  Const xlprevious = 2
  Const xlformulas = 5
  
    wdFileName = BrowseForFile("Select the Word document to process", False)
    If wdFileName = "" Then GoTo lbl_Exit
    Set wdDoc = Documents.Open(wdFileName)
    
    ' clean the word document of all text keeping the tables, and combine the tables and replace spaces and tabs with special characters so it can be separated into columns
    
    RemoveLines
    RemoveParagraphs
    DeleteHeaderRow
    ReplaceTabs
    ReplaceSpace
    
    'copy the word table and paste into excel.
    
    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
    
   
    
    
  
     
    'With xlbook.sheets(2).usedrange
        '.VerticalAlignment = -4160
        '.HorizontalAlignment = -4131
        '.WrapText = False
        '.Orientation = 0
       ' .AddIndent = False
        '.IndentLevel = -1
       ' .ShrinkToFit = False
       ' .ReadingOrder = -5002
        '.MergeCells = False
        '.Columns.AutoFit
   ' End With
  
     
     RegularHours = "=IF(ISNUMBER(SEARCH(""@"",G1)),LEFT(G1,SEARCH(""@"",G1)-1),IF(ISNUMBER(SEARCH(""(("",G1)),0,LEFT(G1,LEN(G1))))"
     'RegularHours = "=IF(ISNUMBER(SEARCH("@",H2)),LEFT(H2,SEARCH("@",H2)-1),IF(ISNUMBER(SEARCH("((",H2)),0,LEFT(H2,LEN(H2))))"
     OtherHours = "=IF(ISERROR(SEARCH(""(("",G1)),0,IF(AND(ISNUMBER(SEARCH(""(("",G1)),ISNUMBER(SEARCH(""@"",G1))),MID(G1,SEARCH(""@"",G1)+1,SEARCH(""(("",G1)-1-SEARCH(""@"",G1)),LEFT(G1,SEARCH(""(("",G1)-1)))"
     'OtherHours = "=IF(ISERROR(SEARCH("((",H2)),0,IF(AND(ISNUMBER(SEARCH("((",H2)),ISNUMBER(SEARCH("@",H2))),MID(H2,SEARCH("@",H2)+1,SEARCH("((",H2)-1-SEARCH("@",H2)),LEFT(H2,SEARCH("((",H2)-1)))"
     HoursCode = "=IF(ISERROR(SEARCH(""(("",G1)),"""",RIGHT(G1,LEN(G1)-SEARCH(""(("",G1)-1))"
          'HoursCode = "=IF(ISERROR(SEARCH("((",H2)),"",RIGHT(H2,LEN(H2)-SEARCH("((",H2)-1))"
     
     EENumber = "=IF(ISERROR(SEARCH(""EE#"",a2)),"""",RIGHT(a2,4))"
     EEName = "=IF(ISERROR(SEARCH("","",a1)),"""",a1)"
     DeductionLabels = "=CONCATENATE(Q1,R1)"
    
   xlbook.Application.DisplayAlerts = False
       
       ' split employee names and department numbers and payrates into three columns using "@" as delimiter
   
   xlbook.sheets(1).Range("b:c").EntireColumn.Insert
      xlbook.sheets(1).Range("a:a").TextToColumns , Destination:=xlbook.sheets(1).Range("a1"), DataType:=xldelimited, _
          TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=False, _
          Semicolon:=False, Comma:=False, Space:=False, Other:=True, otherchar:="@", _
           FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1)), TrailingMinusNumbers:=True
           
           'Split codes for hours into its own column using "Space" as the delimiter
           
   xlbook.sheets(1).Range("e:e").EntireColumn.Insert
      xlbook.sheets(1).Range("d:d").TextToColumns , Destination:=xlbook.sheets(1).Range("d1"), DataType:=xldelimited, _
          TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=False, _
          Semicolon:=False, Comma:=False, Space:=True, Other:=False, _
           FieldInfo:=Array(Array(1, 1), Array(2, 1)), TrailingMinusNumbers:=True
           
           'split hours into regular and other using "@" as the delimiter
           
               
   xlbook.sheets(1).Range("e:e").EntireColumn.Insert
      xlbook.sheets(1).Range("d:d").TextToColumns , Destination:=xlbook.sheets(1).Range("d1"), DataType:=xldelimited, _
          TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=False, _
          Semicolon:=False, Comma:=False, Space:=False, Other:=True, otherchar:="@", _
           FieldInfo:=Array(Array(1, 1), Array(2, 1)), TrailingMinusNumbers:=True
           
           'insert columns for formulas to seperate reqular and other dollars.
           
    xlbook.sheets(1).Range("h:j").EntireColumn.Insert
    
           'inster fourmulas for regular and other dollars.
           
          xlbook.sheets(1).Range("h1").Formula = RegularHours  'Column 8
          xlbook.sheets(1).Range("i1").Formula = OtherHours  'Column 9
          xlbook.sheets(1).Range("j1").Formula = HoursCode 'Column 10
          
          'Split tax amounts and codes into seperate columns based on "(" delimiter
          
    xlbook.sheets(1).Range("m:m").EntireColumn.Insert
      xlbook.sheets(1).Range("l:l").TextToColumns , Destination:=xlbook.sheets(1).Range("l1"), DataType:=xldelimited, _
          TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=False, _
          Semicolon:=False, Comma:=False, Space:=False, Other:=True, otherchar:="(", _
          FieldInfo:=Array(Array(1, 1), Array(2, 1)), TrailingMinusNumbers:=True
          
          'split deductions and deduction codes into columns based on "Space" delimiter
                           
   xlbook.sheets(1).Range("o:o").EntireColumn.Insert
      xlbook.sheets(1).Range("n:n").TextToColumns , Destination:=xlbook.sheets(1).Range("n1"), DataType:=xldelimited, _
          TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=False, _
          Semicolon:=False, Comma:=False, Space:=True, Other:=False, _
          FieldInfo:=Array(Array(1, 1), Array(2, 1)), TrailingMinusNumbers:=True
          
   xlbook.Application.DisplayAlerts = True
   
   xlbook.sheets(1).Range("b:c").EntireColumn.Insert
   xlbook.sheets(1).Range("c1").Formula = EENumber  'Column 3
   xlbook.sheets(1).Range("b1").Formula = EEName  'Column 2
   xlbook.sheets(1).Range("s1").Formula = EEName 'copy entire worksheet and replace formulas with data
   
   'find the last row used in the worksheet
   
    With xlbook.sheets(1)
     If Application.worksheetfunction.CountA(.Cells) <> 0 Then  'took out application and added xlbook
         LastRow = .Cells.Find(What:="*", _
                      After:=xlbook.sheet(1).Range("A1"), _
                      Lookat:=xlpart, _
                      LookIn:=xlformulas, _
                      SearchOrder:=xlbyrows, _
                      SearchDirection:=xlprevious, _
                      MatchCase:=False).Row
     Else
         LastRow = 1
     End If
  End With

  MsgBox LastRow
   
   xlbook.sheets(1).Range("a:b").Copy
   xlbook.sheets(1).Range("A:b").PasteSpecial Paste:=xlValues
   
     
   'fill worksheet with ee name and ee number
   
  With xlbook.sheets(1).usedrange
    .Columns("A:A").Select
    .Selection.SpecialCells(xlCellTypeFormulas, 1).Select
    .Selection.FormulaR1C1 = "=R[-1]C"
    .Columns("A:A").Select
    .Columns("A:A").Copy
    .Columns("A:A").Select
    .Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    .Application.CutCopyMode = False
    
 .Columns("B:B").Select
    .Selection.SpecialCells(xlCellTypeFormulas, 1).Select
    .Selection.FormulaR1C1 = "=R[-1]C"
    .Columns("B:B").Select
    .Columns("B:B").Copy
    .Columns("B:B").Select
    .Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    .Application.CutCopyMode = False
    End With
    
       
    'insert row for headers
   
   'xlbook.Sheets(1).Range("a1").Entirerow.Insert
   
   
  'HoursWorkedCurrent As String
 'Dim SickHoursAccruedCurrent As String, SickHoursTakenCurrent As String, VacationHoursAccruedCurrent As String, VacationHoursTakenCurrent As String
 'Dim SickHoursAccruedYTD As String, SickHoursTakenYTD As String, SickHoursAvailableYTD As String, VacationHoursAccruedYTD As String
 'Dim VacationHoursTakenYTD As String, VacationHoursAvailableYTD As String
  
  
     
lbl_Exit:
     Set xlApp = Nothing
     Set xlbook = Nothing
     Set wdDoc = Nothing
     Exit Sub
 End Sub

Sub Delete_Header_first_row()
Dim oTable As Object
    For Each oTable In ActiveDocument.Range.Tables
        oTable.Cell(1, 1).Select
        Selection.MoveRight Unit:=1, Count:=2, Extend:=1
        Selection.Rows.Delete
    Next oTable
lbl_Exit:
    Set oTable = Nothing
    Exit Sub
End Sub
Sub ReplaceTabs()
'Dim oRng As Object


  'Set oRng = ActiveDocument.Range
    With Selection.Find
        .Text = "^t"
        .Replacement.Text = "@"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
        .MatchCase = True
        .MatchWholeWord = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    
End Sub
Sub ReplaceSpace()
'Dim oRng As Object


  'Set oRng = ActiveDocument.Range
    With Selection.Find
        .Text = Space(2)
        .Replacement.Text = "("
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
        .MatchCase = True
        .MatchWholeWord = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    
End Sub
Sub RemoveHeader()
Dim oRng As Object
Dim i As Long
Dim HeaderList

  HeaderList = Array("Employee", "Hours", "Earnings", "Gross", "Taxes", "Deductions", "Net Pay", "^p^p")
  
  For i = 0 To UBound(HeaderList)
  
    Set oRng = ActiveDocument.Range
    With oRng.Find
        .Text = HeaderList(i)
        .MatchCase = True
        .MatchWholeWord = True
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
        
        .Wrap = 0
        While .Execute
            oRng.Delete
        Wend
    End With
    Next
lbl_Exit:
Set oRng = Nothing
    Exit Sub
End Sub
Sub Removetables()
Dim oTable As Table
For Each oTable In ActiveDocument.Tables
oTable.Delete
Next oTable
End Sub

Sub RemoveParagraphs()
Dim oPara As Paragraph
'Dim answer
For Each oPara In ActiveDocument.Paragraphs
'oPara.Range.Select
'answer = MsgBox(oPara.Range.Information(wdWithInTable))
If Not oPara.Range.Information(wdWithInTable) Then  'checks to see if paragraph is in table, if it is it skipps to the next paragraph, if its not it delets paragraph
oPara.Range.Delete
End If
Next oPara

End Sub


Sub RemoveLines()

  ActiveDocument.Shapes.SelectAll
    Selection.Delete
    
    
End Sub
Sub DeleteHeaderRow()
    Dim sText As String

    sText = "RATE"
    Selection.Find.ClearFormatting
    With Selection.Find
        .Text = sText
        .MatchCase = True
        .MatchWholeWord = True
        .Wrap = wdFindContinue
    End With
    Do While Selection.Find.Execute
        If Selection.Information(wdWithInTable) Then
            Selection.Rows.Delete
        End If
    Loop
End Sub
Sub RemoveSectionBreaks()
Dim oRng As Object
    Set oRng = ActiveDocument.Range
    With oRng.Find
        .Text = "^b"        ' section break
        .Wrap = 0
        While .Execute
            oRng.Delete
        Wend
    End With
lbl_Exit:
Set oRng = Nothing
    Exit Sub
End Sub

Sub DeleteEmptyParas() ' delete empty paragraphs
Dim oPara As Object
    For Each oPara In ActiveDocument.Range.Paragraphs
        If Not oPara.Range.Information(12) Then
            If Len(oPara.Range) = 1 Then oPara.Range.Delete
        End If
    Next oPara
lbl_Exit:
    Set oPara = Nothing
    Exit Sub
End Sub

Function BrowseForFile(Optional strTitle As String, Optional bExcel As Boolean) As String
'Graham Mayor
'strTitle is the title of the dialog box
'Set bExcel value to True to filter the dialog to show Excel files
'The default is to show Word files
Dim fDialog As FileDialog
    On Error GoTo err_Handler
    Set fDialog = Application.FileDialog(msoFileDialogFilePicker)
    With fDialog
        .Title = strTitle
        .AllowMultiSelect = False
        .Filters.Clear
        If bExcel Then
            .Filters.Add "Excel workbooks", "*.xls,*.xlsx,*.xlsm"
        Else
            .Filters.Add "Word documents", "*.doc,*.docx,*.docm"
        End If
        .InitialView = msoFileDialogViewList
        If .Show <> -1 Then GoTo err_Handler:
        BrowseForFile = fDialog.SelectedItems.Item(1)
    End With
lbl_Exit:
    Exit Function
err_Handler:
    BrowseForFile = vbNullString
    Resume lbl_Exit
End Function
'End Function

 Sub DeleteTxtbox()
Dim oShp As Word.Shape
Dim i As Long
For i = ActiveDocument.Shapes.Count To 1 Step -1
Set oShp = ActiveDocument.Shapes(i)
If oShp.Type = msoTextBox Then
oShp.Delete
End If
Next i
End Sub

macropod · #2 05-22-2016, 11:05 PM

Instead of:
Application.worksheetfunction
you should be using:
xlApp.WorksheetFunction

gmayor · #3 05-23-2016, 04:20 AM

Also if you are using late binding to Excel as implied by your designation of Object to the Excel parts, you need to substitute all the Excel specific commands such as 'xldelimited' for their numeric equivalents (in this instance 1). You have more than a few such commands in the code.

gbrew584 · #4 05-23-2016, 04:28 AM

Many thanks for the reply, i thought I tried that, but I think maybe my method of testing the code may have failed. I tried to edit the code and then I would use F8 and drag the yellow arrow down to that bit of code, then I would press F5. but i think the problem is that my code was reset causing the code to loose the stored variables? Is there a way I test just one section of my code? Sorry I'm getting a little off the topic.

i tried your suggestion, but now I i am getting a script out of range error. I added xlbook.sheet(1), in front of .cell, but I don't think that is helping things. I changed sheet to sheets, but nothing happened. I'm getting the script out of range error. Do you have any suggestions for that?

Thanks again for taking the time to help me.

gbrew584 · #5 05-23-2016, 04:33 AM

gmayor,

thanks for the reply and the suggestion. I have added constants to my code to take care of the Excel specific commands, at least I thought that is what I they were doing. Is that not correct? Is there better or more correct way to do this?

macropod · #6 05-23-2016, 05:15 AM

Quote:

Originally Posted by gbrew584

Is there a way I test just one section of my code? Sorry I'm getting a little off the topic.

That's fairly basic. Just use something like:

Code:

Sub Test()
Dim xlApp As Object, xlbook As Object, LastRow As Long
Const xlpart = 2
Const xlbyrows = 1
Const xlprevious = 2
Const xlformulas = 5
Set xlApp = CreateObject("Excel.Application")
Set xlbook = xlApp.workbooks.Add
xlbook.Sheets(1).Range("A1").PasteSpecial
With xlbook.Sheets(1)
    If xlApp.WorksheetFunction.CountA(.Cells) <> 0 Then
        LastRow = .Cells.Find(What:="*", _
                      After:=.Range("A1"), _
                      Lookat:=xlpart, _
                      LookIn:=xlformulas, _
                      SearchOrder:=xlbyrows, _
                      SearchDirection:=xlprevious, _
                      MatchCase:=False).Row
     Else
         LastRow = 1
     End If
  End With
  MsgBox LastRow
End Sub

gbrew584 · #7 05-23-2016, 06:25 AM

Thanks, again, Paul for the suggestion. I guess I just don't know enough about vba to know the basics. Thanks for teaching me. I doubt I would know which bit of code to keep to do a test, but i appreciate the pointers. I can experiment with your advice and see how it goes.

Do you have any tips or hints as to why the code stops at

Code:

 LastRow = .Cells.Find(What:="*", _
                      After:=.Range("A1"), _
                      Lookat:=xlpart, _
                      LookIn:=xlformulas, _
                      SearchOrder:=xlbyrows, _
                      SearchDirection:=xlprevious, _
                      MatchCase:=False).Row

macropod · #8 05-23-2016, 04:37 PM

That part of the code works fine for me, as I expect you'd see by running the test macro I included it with.

gmayor · #9 05-23-2016, 08:54 PM

It doesn't work for me either - but the following does. Note that Paul's code will leave an invisible instance of Excel running, with a worksheet containing the pasted values, which you will need to close from Windows Task manager. If you are going to run Excel invisibly then ensure that you close the workbook and quit the Excel application when it is finished with. The following displays the workbook for testing purposes.

Code:

Sub Test()
Dim xlApp As Object, xlbook As Object, LastRow As Long

    Set xlApp = CreateObject("Excel.Application")
    xlApp.Visible = True
    Set xlbook = xlApp.workbooks.Add
    xlbook.Sheets(1).Range("A1").PasteSpecial
    With xlbook.Sheets(1)
        If xlApp.WorksheetFunction.CountA(.Cells) <> 0 Then
            LastRow = xlbook.Sheets(1).Range("A" & xlbook.Sheets(1).Rows.Count).End(-4162).Row
        Else
            LastRow = 1
        End If
    End With
    MsgBox LastRow
End Sub

gbrew584 · #10 05-24-2016, 04:28 AM

Thanks for the help and the great suggestions. I did as Paul suggested and tried to run the snipet of code by itself but it failed, that is what prompted my question about why it stopped working. I try to do my part and i always try people suggestions, run the code, make corrections, and then do tests before I come back and say something isn't working. I Appreciate that you are taking the time to help me as I am trying to lean more about writing code.

I will work on the code this afternoon to try and get the kinks worked out, thanks for your suggestions. I'll keep you posted on the progress. Thanks!!

Similar Threads
Thread	Thread Starter	Forum	Replies	Last Post
Word to Excel Links Stop Working	DAC8190	Word	1	10-08-2015 05:56 PM
Controlling Widows (single-word lines at the end of a paragraph)	downtownbooks	Word	2	12-09-2014 03:57 PM
Word and Excel stopped working	judyn	Office	9	04-23-2013 05:10 AM
Controlling search option in word	suvvi	Word	0	08-05-2011 06:10 AM
working with excel tables in MS word	radman154	Word Tables	1	03-25-2011 12:04 AM