Macro for removing some parts of data, using LEFT/RIGHT functions

G

Guest

Hi all.
I have a spreadsheet that copies and transposes data .. each set of data is
a single line.
Now I need to do some LEFT/RIGHT trimming etc to the data to move some of
the rubbish... and i was hoping i could put it into the macro i have. could
someone please assist with below?

Data is currently transposed to look like this
columns
col A = 1. joe bloggs ConstructionPhone: (06) 111-1111
col b = Fax: (06) 222-2222
col c =999 Young Street
col d= New Plum
col e= PO Box 880
col f = New Plum, 4615


What i need it to look like is this:
columns
col a = joe bloggs Construction //remove the first 3 characters
(ie
number "1.")
col b= (06) 111-1111 //remove the word Phone:
col c=(06) 222-2222 //remove the word fax
col d =999 Young Street
col e= PO Box 880
col f = New Plum //split the postcode
col g =4615

I currently have it working in a rather adhoc manner into a few hidden
sheets using LEFT/RIGHT etc, but was hoping there was a way to do this in the
macro... to tidy it up...
thanks in advance
Sach
 
T

Tim Williams

something like

How about somthing like this?
It shifts the processed data over to the right rather than overwriting the
original data: should make your QA process easier.

Tim

***********************************************
Sub Reformat()

Dim r As Long
Dim s As String, a As Variant
r = 1

With ActiveSheet
Do While .Cells(r, 1).Value <> ""

s = Trim(.Cells(r, 1).Value)
s = Right(s, Len(s) - 3)
a = Split(s, "Phone:")
.Cells(r, 10).Value = a(0)
If UBound(a) > 0 Then .Cells(r, 11).Value = a(1)
.Cells(r, 12).Value = Replace(.Cells(r, 2).Value, "Fax:", "")
.Cells(r, 13).Value = .Cells(r, 4).Value
.Cells(r, 14).Value = .Cells(r, 5).Value
a = Split(Trim(.Cells(r, 6).Value), ",")
.Cells(r, 15).Value = a(0)
If UBound(a) > 0 Then .Cells(r, 16).Value = a(1)

r = r + 1
Loop
End With

End Sub

*************************************************
 
Top