PDA

View Full Version : [SOLVED] Create a Mailing List from unformatted data



Tinku
04-28-2005, 04:38 PM
I have a spreadsheet which has unformatted data.
The Address of the company is on three rows instead of one.
I want to have the data moved to one row so that I can use
it for a mailmerge.

Regards
Tinku

acw
04-28-2005, 05:51 PM
HI

Assuming that your data starts in B1 and the first entry would cover B1:B3 then enter the following


=OFFSET($B$1,(ROW()-1)*3,0) & OFFSET($B$1,(ROW()-1)*3+1,0) & OFFSET($B$1,(ROW()-1)*3+2,0)

and copy down.

HTH

Tony

Tinku
04-29-2005, 04:10 AM
Thanks acw

do I just paste this or this has to go into a loop ?

Regards
Tinku

austenr
04-29-2005, 06:19 AM
I believe that is taken care of in the formula. Just copy down as suggested.

Tinku
04-29-2005, 07:06 AM
This doesnt work or I am doing something wrong here..:banghead:
I have attached a sample file for reviewing the results.


Regards
Tinku

austenr
04-29-2005, 07:17 AM
Try putting the formula in column A

Tinku
04-29-2005, 07:22 AM
Doesnt work..same results.. I dug up some code which works:clap:
Thanks to Sandam..:thumb


Option Explicit
'this variable records the largest amount of
'rows created by the export
Private MaxRows As Integer

'this sub compares the row count from FixFormat1
'to the max of the last one
Private Sub CheckMax(sNum As Integer)
If sNum > MaxRows Then
MaxRows = sNum
End If
End Sub

'This is the sub that takes the "," delimited cell value
',splits it, and pastes the parts into seperate columns
Private Sub FixFormat2()
Dim I As Integer, J As Integer
Dim LastRow As Long
Dim temp() As String

Range("C1").Select
For I = 1 To MaxRows
'inserting extra columns
Selection.EntireColumn.Insert
Next I
'working form the bottom row again
LastRow = Range("B65536").End(xlUp).Row
For I = LastRow To 2 Step -1
'split the cell value
temp = Split(Range("B" & I).Text, ",")
'paste it into the columns
For J = 1 To UBound(temp) + 1
Range(Chr(Asc("B") + J) & I).Value = temp(J - 1)
Next J
Next I
'delete the un-needed column with the
'concatenated string
Range("B1").Select
Selection.EntireColumn.Delete
End Sub

'sub to concatenate the rows of one column
Private Sub FixFormat1()
Dim LastRow As Long
Dim x As Long
Dim NumRows As Integer

NumRows = 1
LastRow = Range("B65536").End(xlUp).Row
For x = LastRow To 2 Step -1
If Range("A" & x).Value = "" Then
'Selection.Insert Shift:=xlToRight
Range("B" & x - 1).Value = Range("B" & x - 1).Value & "," & Range("B" & _
x).Value
Range("B" & x).EntireRow.Delete
NumRows = NumRows + 1
Else
CheckMax (NumRows)
NumRows = 1
End If
Next x
End Sub

Sub FixSheetFormat()
'this sub just runs the two seperate subs and
'sets the initial value of maxrows
MaxRows = 1
FixFormat1
FixFormat2
End Sub