Export from PDF then Text to Column

[tuongtu3]

Hello All,
I have to export a PDF to notepad or excel then do TEXT to COLUMN at each double SPACES in text string was found. Please see sample attached and thank you very much in advance.

Regards,
tt3

[AliGW]

1. Use this formula in B1 to replace the double spaces with a semi-colon: =SUBSTITUTE(A1," ",";") - copy down.
2. Copy and paste the VALUES of the results over the formula results in column B.
3. Use Text to Columns on these values and define a semi-colon as the delimiter.

[tuongtu3]

Hi AliGW,
Thank you for your formula but it did not work as I expect because how to move the cell "A4" to the last column of above row. Please look at my sample to see a result tab.

Regards,
tt3

[AliGW]

how to move the cell "A4" to the last column of above row.

Sorry - I didn't see that final requirement. And sorry, I can't help you with that bit. However, what I have done should get you started.

[tuongtu3]

Any other suggestions please.

Regards,
tt3

[tuongtu3]

Hello All,
I came up with the below Macro Recording but something not right. Please take a look a and help:

Sub tt3()
Range("B1:B25").Formula = "=SUBSTITUTE(A1,"" "","";"")"

Columns("B:B").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

'''Text2Column
Columns("B:B").Select
Selection.TextToColumns Destination:=Range("B1"), DataType:=xlDelimited, _
TextQualifier:=xlNone, ConsecutiveDelimiter:=False, Tab:=False, _
Semicolon:=True, Comma:=False, Space:=False, Other:=False, OtherChar _
:=" ", FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, _
1), Array(6, 1), Array(7, 1), Array(8, 1), Array(9, 1), Array(10, 1)), _
TrailingMinusNumbers:=True
Columns("B:J").Select
Columns("B:J").EntireColumn.AutoFit
With Selection
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlBottom
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With

Dim Lr As Long, Lc As Long
Lr = Range("B" & Rows.Count).End(xlUp).Row
Lc = Cells(2, Columns.Count).End(xlToLeft).Column
For i = Lr To 3 Step -1
If Len(Cells(i, 2)) > 1 Then

Cells(i, 2).Resize(1, 4).Copy Destination:=Cells(i, 2).Offset(-1, Lc) <=== i got a problem here how to paste to last column of above Row??
Cells(i, 2).Resize(1, 18).Select
Selection.Delete Shift:=xlUp
End If
Next i

'''ArrangeColumn
Columns("A:A").Select
Selection.Delete Shift:=xlToLeft
Columns("E:E").Select
Selection.Cut
Columns("B:B").Select
Selection.Insert Shift:=xlToRight
Columns("E:E").Select
Selection.Cut
Columns("D:D").Select
Selection.Insert Shift:=xlToRight
Columns("G:G").Select
Selection.Cut
Columns("J:J").Select
Selection.Insert Shift:=xlToRight

Range("A1").Select

End Sub

Regards,
tt3