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
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