Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations wOOdy-Soft on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

moving data from rows to columns with vba

Status
Not open for further replies.

umbletech

IS-IT--Management
Jan 29, 2006
196
Hi All

After much data cleansing on a really rubbish data set have got:

24/7 ROAD SERVICES PTY LTD

PO BOX 129
NEWCASTLE NSW


3UZ P/L

8TH FLOOR / 766 ELIZABETH ST
CARLTON VIC 3053
Phone No: 9347 8111
ACCIDENT ALLOCATION DEPOT 801
BRAD
I'm trying to get it into this format for a mailmerge

FirstName Address1 Address2
24/7 ROAD SERVICES PTY LTD PO BOX 129 NEWCASTLE NSW

Now obviously a simple column transpose thru the gui's gonna leave me worse off.

So I guess I need
a) Some code that loops thru in that column (col C) and cuts any text that has a blank cell above and below it (that will get all the customer names)

b) Code that starts when it hits a non-blank cell and moves each line to a new column.

OK I'm a complete VBA newbie can anyone fix my code for a) Getting rid of those nasty nested IFs would be a great start.

This bit should copy the customer names over by looking for blank cells above and below:

Range("C2").Select 'Sets the starting point
Reset: ' Label to get back to the loop
'Should select the next non-blank cell
ActiveCell.Offset(1, 0).Select
Do While Not IsEmpty(ActiveCell)
ActiveCell.Offset(1, 0).Select
Loop
'Once the cell's selected this code should check that it has blank cell's above and below and if not go back to the loop

If ActiveCell.Offset(-1, 0) Is Nothing Then
If ActiveCell.Offset(1, 0) Is Nothing Then
ActiveCell.Select
Selection.Copy
ActiveCell.Offset(0, -1).Select
ActiveSheet.Paste
Else: GoTo Reset
End If
Else: GoTo Reset
End If

End Sub
 
How about uploading the data from the column into a array, then loop through that array to populate the row


Dim arr as variant
int_cnt = 1

Do until XXXX
if cell(int_r,int_c)is not blank ' where int_r and int_c = row, number respectivly

redim arr(int_cnt) = cell(int_r,int_c)
int_cnt = int_cnt + 1
end if

int_R = int_r + 1

Loop




Chance,

Filmmaker, taken gentleman and crunch day + 22
 
Thanks

I actually found a better way on chip pearson's site. It was coming from 2 files - 1 was incorrect but nicely formatted the other vica versa - found a way to remove the differences and use the nice one.

But I'm trying to build my knowledge in the area of data imports and cleansing so the code's much appreciated.

Q? Will this preserve the positioning? And i assume do until x would be EOF?
 
Here i put together a quick FAQ

faq707-6212



Chance,

Filmmaker, taken gentleman and crunch day + 22
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top