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
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