Home Menu

Menu


ExcelBanter » Excel Newsgroups » Setting up and Configuration of Excel > VBScipt: Can you hrlp me automate this ?
Reply
 
LinkBack Thread Tools Search this Thread Display Modes
  #1   Report Post  
Posted to microsoft.public.excel.setup
external usenet poster
  
Posts: 208
Default VBScipt: Can you hrlp me automate this ?
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.



Reply With QuoteReply With Quote
  #2   Report Post  
Posted to microsoft.public.excel.setup
external usenet poster
  
Posts: 2,480
Default VBScipt: Can you help me automate this ?
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 FRight
clickInertMove cells to Right.
--
Regards
Roger Govier

"Sean" wrote in message
...
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.



Reply With QuoteReply With Quote
  #3   Report Post  
Posted to microsoft.public.excel.setup
external usenet poster
  
Posts: 208
Default VBScipt: Can you help me automate this ?
Many Thanks Roger ! Your a Life Saver !

Cheers

Sean.

"Roger Govier" wrote:

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 FRight
clickInertMove cells to Right.
--
Regards
Roger Govier

"Sean" wrote in message
...
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.



Reply With QuoteReply With Quote
Reply
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes
Linear Mode Linear Mode

Posting Rules
Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On

Similar Threads
Thread Thread Starter Forum Replies Last Post
Is it Possible to Automate a Graph? Adam Charts and Charting in Excel 3 October 24th 06 04:19 PM
Automate MTD summation Cheryl Excel Worksheet Functions 2 July 6th 06 04:20 PM
automate formula pboost1 Excel Discussion (Misc queries) 2 March 2nd 06 07:52 PM
Automate without add-ins Rob Oldfield Excel Discussion (Misc queries) 3 October 21st 05 07:33 PM
Automate Add-in Gary's Student Excel Discussion (Misc queries) 4 June 20th 05 02:12 AM


All times are GMT +1. The time now is 05:42 AM.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
Copyright ©2004-2024 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"

 

Contact Us ExcelBanter forum home Privacy Statement