# Thread: Moving data from column B:B into new columns?

1. ## Moving data from column B:B into new columns?

Hello!
I needed a fix for a problem I'm currently being asked to solve but simply cannot find a solution.
On column A, I have a list of names. On column B, I have their address.
Sometimes, however, a person has more than one address and I wanted to move the addresses to new columns titled "Property 1, Property 2, and so on".
If anybody could help me with it, I'd greatly appreciate it.
I have attached a sample workbook to make things easier!

Thank you so much guys!

2. Try this:

In C2, add a helper formula to fill all cells with a name...

=IF(A2="",C1,A2)

copied down.

Then in D2 enter formula to get unique names:

=IFERROR(INDEX(\$A\$2:\$A\$9,SMALL(IF(\$A\$2:\$A\$9<>"",ROW(\$A\$2:\$A\$9)-ROW(\$A\$2)+1),ROWS(\$D\$2:\$D2))),"")

adjust ranges to suit, then confirm with CTRL+SHIFT+ENTER not just ENTER and copy down.

In E2 enter similar formula:

=IF(\$D2="","",IFERROR(INDEX(\$B\$2:\$B\$9,SMALL(IF(\$C\$2:\$C\$9=\$D2,ROW(\$B\$2:\$B\$9)-ROW(\$B\$2)+1),COLUMNS(\$E\$2:E\$2))),""))

again, adjusting ranges to suit, then confirm with CTRL+SHIFT+ENTER and copy down and across the columns.\

Note: Do not use whole column references, and use minimum sizes possible to avoid processor slow downs due to array formulas.

3. Hi Yet

This Code is in the attached and appears to do as you require...CTRL + x will fire the Code.
Code:
Option Explicit
Sub Properties()
Dim ws           As Worksheet
Dim LR           As Long
Dim i            As Long
Dim cnt          As Long
Dim cel          As Range
Dim LastVal      As String
cnt = 1
Set ws = Sheets("Sheet1")
Application.ScreenUpdating = False
With ws
LR = .Cells.Find("*", .Cells(.Rows.Count, .Columns.Count), SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious).Row
.Range("A1:A" & LR).Select
LastVal = ""
For Each cel In Selection.Cells
If Trim(cel.Value) <> "" Then
LastVal = cel.Value
Else
If LastVal <> "" Then cel.Value = LastVal
End If
Next cel
.Range("B1").Value = "Property 1"
.Range("B1").AutoFill Destination:=Range("B1:E1"), Type:=xlFillDefault
For i = LR To 2 Step -1
If .Range("A" & i - 1).Value = .Range("A" & i).Value Then
.Range("A" & i - 1).End(xlToRight).Offset(0, 1).Resize(1, cnt).Value = .Range("A" & i).Offset(0, 1).Resize(1, cnt).Value
cnt = cnt + 1
.Range("A" & i).EntireRow.Delete
Else
End If
Next i
.Columns.AutoFit
End With
Application.ScreenUpdating = True
End Sub

#### Posting Permissions

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