Create a Mailing List from unformatted data

[Tinku]

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]

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]

Thanks acw

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

Regards
Tinku

[austenr]

I believe that is taken care of in the formula. Just copy down as suggested.

[Tinku]

This doesnt work or I am doing something wrong here..
I have attached a sample file for reviewing the results.


Regards
Tinku

[austenr]

Try putting the formula in column A

[Tinku]

Doesnt work..same results.. I dug up some code which works
Thanks to Sandam..

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