VBScipt: Can you hrlp me automate this ?

[Sean]

I have a text file that I want to import into excel. However the file is
formatted in a strange way:

Key Name Customer
ADVANCED ADVANCED LTD
20 TRADING ESTATE
WILL ROAD
WORTS
WEST SUS
BU11 8OP
Telephone : 01103 221111
Fax : 01103 444449
Category : P
Quality : T
Acc Code : A33

ALWIN ALWIN CO LTD
ELL ROAD
BROMLAND
WEST SUS
B70 0DW
Telephone : 0111 117 1234
Fax : 0111 511 9111
Category : S
Quality : T
Acc Code : A48

and this goes on for 1600 lines.

I have recorded the following macro to move the records into each column and
to then delete the gap left behind so that looks like:

KEYNAME NAME ADD1 ADD2 ADD3 ADD4 PCODE TEL FAX CAT QUAL ACC
xxxxxxxxx xxxxxx xxxx xxxxx xxxxx xxxxx xxxxxx xxx xxx xxx xxxxx xxxx
xxxxxxxxx xxxxxx xxxx xxxxx xxxxx xxxxx xxxxxx xxx xxx xxx xxxxx xxxx

Here is the macro:

Range("B3").Select
Selection.Cut Destination:=Range("C2")
Range("B4").Select
Selection.Cut Destination:=Range("D2")
Range("B5").Select
Selection.Cut Destination:=Range("E2")
Range("E2").Select
ActiveWindow.SmallScroll ToRight:=1
Range("B6").Select
Selection.Cut Destination:=Range("F2")
Range("B7").Select
Selection.Cut Destination:=Range("G2")
Range("G2").Select
ActiveWindow.ScrollColumn = 3
ActiveWindow.ScrollColumn = 2
ActiveWindow.ScrollColumn = 1
Range("B8").Select
Selection.Cut Destination:=Range("H2")
Range("H2").Select
ActiveWindow.ScrollColumn = 4
ActiveWindow.ScrollColumn = 3
ActiveWindow.ScrollColumn = 2
ActiveWindow.ScrollColumn = 1
Range("B9").Select
Selection.Cut Destination:=Range("I2")
Range("I2").Select
ActiveWindow.ScrollColumn = 5
ActiveWindow.ScrollColumn = 4
ActiveWindow.ScrollColumn = 3
ActiveWindow.ScrollColumn = 2
ActiveWindow.ScrollColumn = 1
Range("B10").Select
Selection.Cut Destination:=Range("J2")
Range("J2").Select
ActiveWindow.ScrollColumn = 5
ActiveWindow.ScrollColumn = 4
ActiveWindow.ScrollColumn = 3
ActiveWindow.ScrollColumn = 2
ActiveWindow.ScrollColumn = 1
Range("B11").Select
Selection.Cut Destination:=Range("K2")
Range("K2").Select
ActiveWindow.ScrollColumn = 6
ActiveWindow.ScrollColumn = 5
ActiveWindow.ScrollColumn = 4
ActiveWindow.ScrollColumn = 3
ActiveWindow.ScrollColumn = 2
ActiveWindow.ScrollColumn = 1
Range("B12").Select
Selection.Cut Destination:=Range("L2")
Range("L2").Select
ActiveWindow.ScrollColumn = 9
ActiveWindow.ScrollColumn = 8
ActiveWindow.ScrollColumn = 7
ActiveWindow.ScrollColumn = 6
ActiveWindow.ScrollColumn = 5
ActiveWindow.ScrollColumn = 4
ActiveWindow.ScrollColumn = 3
ActiveWindow.ScrollColumn = 2
ActiveWindow.ScrollColumn = 1
Range("A3:A13").Select
Selection.EntireRow.Delete

Now, my question is, how do I increment the rows and columns in each
statement so that I can run the script to move every row into the relevant
columns ?

As always, any help appreciated.

Sean.

 

[Roger Govier]

Hi Sean

Your macro recorded code simplifies to
Sub test()
Range("B3").Cut Destination:=Range("C2")
Range("B4").Cut Destination:=Range("D2")
Range("B5").Cut Destination:=Range("E2")
Range("B6").Cut Destination:=Range("F2")
Range("B7").Cut Destination:=Range("G2")
Range("B8").Cut Destination:=Range("H2")
Range("B9").Cut Destination:=Range("I2")
Range("B10").Cut Destination:=Range("J2")
Range("B11").Cut Destination:=Range("K2")
Range("B12").Cut Destination:=Range("L2")
Range("A3:A13").EntireRow.Delete
End Sub

as the macro recorder makes Selects before carrying out the processing, and
records your movements around the screen whilst recording.

This can be changed to work as a series of loops.
lr determines how many rows there are on the page. It then divides this
figure by 13, and takes the Integer of this value and adds 2, to ensure we
have a count for the outer loop which is 1 greater than the number of
"blocks" of data to process.
This calculated value is used as the upper limit for the "i" loop which
starts at 2

The loop selects column "A" for the row determined by "i"
tbl is then set to be the Current Region, which determines the range down to
the first blank row.

We then have an inner loop "j" which goes from 3 to 12 to deal with moving
data to columns C (3) to L (12)
This loop is always cutting from column "B" stepping up one row at a time,
and writing to Row i, Column j

When the inner loop is completed, tbl is resized to be the range of blank
cells below row "i" down to the next block of data, and these rows are
deleted.

Sub test2()
Dim i As Long, j As Long, x As Long, lr As Long
Dim tbl As Range

lr = Cells(Rows.Count, "B").End(xlUp).Row + 1
lr = Int(lr / 13) + 2

For i = 2 To lr
Cells(i, "A").Select
Set tbl = ActiveCell.CurrentRegion
x = i + 1
For j = 3 To 12
Cells(x, "B").Cut Destination:=Cells(i, j)
x = x + 1
Next j

tbl.Offset(i, 0).Resize(tbl.Rows.Count - (i - 1), 2).EntireRow.Delete

Next i
End Sub

The problem that will still exist for you, if your posted sample data is
correct, is that the second block of data has one fewer row of address,
hence you will have Telephone appearing under postcode, and all other data
being displace one column to the left of where it should be.

Anyway, I hope this helps you to get started on the problem, even if there
are a few rows at the end where you need to select a cell in column F>Right
click>Inert>Move cells to Right.

 

[Sean]

Many Thanks Roger ! Your a Life Saver !

Cheers

Sean.