Results 1 to 4 of 4
  1. #1
    Star Lounger
    Join Date
    Oct 2012
    Posts
    60
    Thanks
    15
    Thanked 0 Times in 0 Posts

    Script or macro needed, or instructions to create same

    Thanks in advance. I am sure this is something simple for the spreadsheet mavens out there...

    I have a spreadsheet of business listings. It is a single column, that I wish to separate into four columns. The column contains info in blocks of 4 lines. I need something to move the data into four columns.

    The data is as follows.

    Name of business
    business address
    business city
    business contact
    2 blank lines
    Next Name of business
    business address
    business city
    business contact
    etc...

    I want to end up with four columns, one each for each business entity.
    Attached Images Attached Images

  2. #2
    Super Moderator RetiredGeek's Avatar
    Join Date
    Mar 2004
    Location
    Manning, South Carolina
    Posts
    9,435
    Thanks
    372
    Thanked 1,457 Times in 1,326 Posts
    schwenzerp,

    This should do the trick:
    Code:
    Option Explicit
    
    Sub ReFmtList()
    
       Dim lCurRow   As Long
       Dim iItemCntr As Integer
       
       lCurRow = 1
       
       Do
       
         For iItemCntr = 1 To 3
            Cells(lCurRow, iItemCntr + 1).Value = Cells(lCurRow + iItemCntr, 1).Value
         Next iItemCntr
         
         Range(Cells(lCurRow + 1, 1), Cells(lCurRow + 5, 1)).EntireRow.Delete
         
         lCurRow = lCurRow + 1
       
       Loop Until Cells(lCurRow, 1).Value = ""
       
    
       Columns("A:D").EntireColumn.AutoFit
       
    End Sub  'ReFmtList
    Results:
    schwenzerp.JPG

    As always make sure you run this on a COPY of your file first!

    HTH
    May the Forces of good computing be with you!

    RG

    PowerShell & VBA Rule!

    My Systems: Desktop Specs
    Laptop Specs

  3. #3
    Gold Lounger Maudibe's Avatar
    Join Date
    Aug 2010
    Location
    Pa, USA
    Posts
    2,637
    Thanks
    115
    Thanked 650 Times in 592 Posts
    Very familiar with the area schwenzerp. If RG's excellent code does not work for you, here is alternative VBA approach transposing using the PasteSpecial method

    HTH,
    Maud

    Code:
    Sub TransposeList()
    Dim LastRow As Long, row As Long
    LastRow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).row
    row = 2
    For I = 2 To LastRow Step 6
        Range("A" & I & ":A" & I + 3).Copy
        Range("B" & row).PasteSpecial Transpose:=True
        row = row + 1
    Next I
    Columns("A:A").EntireColumn.Delete
    Columns("A:D").EntireColumn.AutoFit
    End Sub
    Transpose1.png
    Attached Files Attached Files

  4. #4
    Super Moderator
    Join Date
    May 2002
    Location
    Canberra, Australian Capital Territory, Australia
    Posts
    5,054
    Thanks
    2
    Thanked 417 Times in 346 Posts
    You could do all of that via a simple OFFSET formula on another sheet. For example:
    =OFFSET(Sheet1!$A$1,(COLUMN()-1)+(ROW()-1)*6,0)
    in A1 of sheet2, copy across to D1, then down as far as needed (1/6th # of businesses).
    If you want to have a header row, use:
    =OFFSET(Sheet1!$A$1,(COLUMN()-1)+(ROW()-2)*6,0)
    in A2 of sheet2, copy across to D1, then down as far as needed.

    No macros required and the list auto-updates as you edit entries, including the addition/deletion of new records (additions provided you copy down another row on the output sheet)
    Cheers,

    Paul Edstein
    [MS MVP - Word]

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •