problems with the word-exel comand

F

filo666

Hi, I have a file that first save each one of the words of a document, after
that, it paste the words in an excel file and then counts and deletes the
repeated words, my problem is in the exl.sort command, the program breaks
when it arrives to the sort procedure of excel, I attached the code, please
help
Sub Macro1()
Dim arr1()
cntr1 = 0
a = ActiveDocument.Characters.Count
For n = 1 To a
If ActiveDocument.Characters(n).Text = " " Then
cntr1 = cntr1 + 1
ReDim Preserve arr1(cntr1)
arr1(cntr1) = word1
letter1 = Empty
word1 = Empty
Else
letter1 = ActiveDocument.Characters(n).Text
word1 = word1 + letter1
End If
Next
Set exl = CreateObject("excel.Application")
exl.workbooks.Add
exl.Visible = True
exl.Cells(1, 1).Select
cntr3 = 1
For cntr3 = 1 To UBound(arr1)
exl.Cells(cntr3 + 1, 1) = arr1(cntr3)
Next
exl.Columns("A:A").Select

‘’’’’’’’’’’’’’’’’’’’’’’’The program breaks here
exl.Selection.Sort Key1:=Range("A2"), Order1:=xlDescending, Header:=xlYes, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
‘’’’’’’’’’’’’’’’’’’’’’’’The program breaks here

For b = 2 To UBound(arr1)
cntr12 = 1
For C = 2 To UBound(arr1)
If exl.activesheet.Cells(b, 1) = exl.activesheet.Cells(C, 1) And b <> C Then
exl.Rows(C).Delete
C = C - 1
cntr12 = cntr12 + 1
If exl.Cells(C, 1) = Empty Then
GoTo endsub
End If
End If
Next
exl.Cells(b, 2) = cntr12
Next
exl.Range("A1") = "Word"
exl.Range("B1") = "Counter"
exl.Columns("A:A").Sort Key1:=Range("A2"), Order1:=xlAscending,
Header:=xlYes, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
endsub:
End Sub

thanks
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top