Word 2010 to XL problems 2

[RonRepp]

Current Resident	Current Resident	Current Resident
629 MAIN STREET	        618 MAIN STREET	        123 MAIN STREET
MONTELLO WI  53949	MONTELLO WI  53949	MONTELLO WI  53949

I have a list in Word (above) that my client wants me to put into Excel. The problem is that it isn't setup on a label template, but the author did it using tab stops and spaces. I'm trying to take the list (22 pages) and send it to XL so that it's a genuine list (first col= Name, 2nd col = Address 3rd col = CSZ)

Some of these have four lines, some have 3. Also, some use the Tab character in it, which I've tried to split out, but some just use spaces. This is what I've tried.

Sub TestSelect2()
Dim XL As New Excel.Application
Dim i As Integer
Dim arr As Variant
Dim j As Variant
Dim k As Integer
Dim L As Integer
Set XL = New Excel.Application
With XL
    .Visible = True
    .Workbooks.Add
End With
On Error Resume Next

XL.Range("A1").Activate
XL.ActiveCell.Value = "Name"
XL.ActiveCell.Offset(0, 1).Value = "Address"
XL.ActiveCell.Offset(0, 2).Value = "NACSZ"
XL.ActiveCell.Offset(0, 3).Value = "Unknown"

For i = 1 To Word.ActiveDocument.Paragraphs.Count
        j = Word.ActiveDocument.Paragraphs(i)
        arr = Split(j, vbTab)
        XL.ActiveCell.Offset(1, 0).Activate
For k = LBound(arr) To UBound(arr)
    L = L + 1
    If L = 1 Then
        XL.ActiveCell.Value = arr(k)
    ElseIf L = 2 Then
        XL.ActiveCell.Offset(0, 1).Value = arr(k)
    ElseIf L = 3 Then
        XL.ActiveCell.Offset(0, 2).Value = arr(k)
    ElseIf L = 4 Then
        XL.ActiveCell.Offset(0, 3).Value = arr(k)
        L = 0
        Exit For
    End If
    
       'Debug.Print arr(k)
    Next k
    
        XL.ActiveCell.Offset(1, 0).Activate
Next i
End Sub

Any help will be greatly appreciated.

Ron Repp

If gray hair is a sign of wisdom, then I'm a genius.

My newest novel: Wooden Warriors

http://www.repproductions.net

 

[SkipVought]

Hi,

So how is your code performing?

Skip,

_{Just traded in my OLD subtlety...
for a NUance!}

 

[RonRepp]

Hi, Skip:

I've tweaked it some, but am beginning to believe that I need to add more arrays. I'm not good w/arrays, but...

The code--when this was originally posted--would take the first paragraph and insert it into a row of Excel. Not really what I wanted, since I wanted it setup in a NACSZ format. Instead, I'm getting Name, Name, Name--then Address, Address, Address--then CSZ, CSZ, CSZ. I'll repost what I have changed.

Sub TestSelect3()
Dim XL As New Excel.Application
Dim i As Integer
Dim arr As Variant
Dim j As Variant
Dim k As Integer
Dim L As Integer
Set XL = New Excel.Application
With XL
    .Visible = True
    .Workbooks.Add
End With
On Error Resume Next

XL.Range("A1").Activate
XL.ActiveCell.Value = "Name"
XL.ActiveCell.Offset(0, 1).Value = "Address"
XL.ActiveCell.Offset(0, 2).Value = "NACSZ"
XL.ActiveCell.Offset(0, 3).Value = "Unknown"
XL.ActiveCell.Offset(1, 0).Activate
For i = 1 To Word.ActiveDocument.Paragraphs.Count
        j = LTrim(Word.ActiveDocument.Paragraphs(i))
        arr = Split(j, vbTab)
        arr = RTrim(arr)
        arr = Replace(arr, vbTab, "")
        arr = Replace(arr, "", "")
For k = LBound(arr) To UBound(arr)
    L = L + 1
    If L = 1 Then
        XL.ActiveCell.Offset(0, -1).Value = arr(k)
    ElseIf L = 2 Then
        XL.ActiveCell.Offset(0, 0).Value = arr(k)
    ElseIf L = 3 Then
        XL.ActiveCell.Offset(0, 1).Value = arr(k)
    ElseIf L = 4 Then
        XL.ActiveCell.Offset(0, 2).Value = arr(k)
        L = 0
        Exit For
    End If
    
       'Debug.Print arr(k)
    Next k

        XL.ActiveCell.Offset(1, 0).Activate
Next i
End Sub

Originally it was leaving ColA blank. I think because I'm splitting by the Tab.


Ron Repp

If gray hair is a sign of wisdom, then I'm a genius.

My newest novel: Wooden Warriors

http://www.repproductions.net

 

[PHV]

I'd comment out the On Error Resume Next line.
I'm not sure you can use an array with the RTrim and Replace functions.

Hope This Helps, PH.
FAQ219-2884
FAQ181-2886

 

[RonRepp]

Thanks, PHV:

I put the error resume remark in there because there is a row (somewhere in the 22 pages) that makes the code halt. I've tried trapping it, but it just takes me to the Next k remark.

Ron Repp

If gray hair is a sign of wisdom, then I'm a genius.

My newest novel: Wooden Warriors

http://www.repproductions.net

 

[RonRepp]

PHV:

Good call on the resume err remark and the trim statements.

Ron Repp

If gray hair is a sign of wisdom, then I'm a genius.

My newest novel: Wooden Warriors

http://www.repproductions.net

 

[Andrzejek]

[blue]arr = Split(j, vbTab)[/blue]
arr = RTrim(arr)
arr = Replace(arr, vbTab, "")  [green]' ???[/green]

If you Split text by Tab, you will NOT have any Tabs left in any of the elements. So why replacing non-existing Tabs with an empty string?

Have fun.

---- Andy