# Retrieve 1 Column of Data into 3 different columns

#### asalman07

##### Active Member
In column A i have text formatted like below. The list is much larger than the sample below. I am trying to get on Column C, D, and E the F, B, and G accounts independently listed. For example, on Column C i want all accounts that house the letter F, on Column D all accounts that house the letter B, and finally on Column E, all acccounts that house the letter G.

 180F - Unif/Printing/Forms and Supp 420B - Maint Materials & Supplies 430B - Inventory Support Fees 490B - Uniforms Forms & Supplies 530B - Printing and Duplication 720G - Materials/Supplies 570G - Inventory Support Fees 700G - Office/Computer Supplies 710G - Small Tools 730G - Uniforms 810G - Printing/Duplication

<TBODY>
</TBODY><COLGROUP><COL></COLGROUP>

### Excel Facts

Which came first: VisiCalc or Lotus 1-2-3?
Dan Bricklin and Bob Frankston debuted VisiCalc in 1979 as a Visible Calculator. Lotus 1-2-3 debuted in the early 1980's, from Mitch Kapor.
Give this macro a try...
Code:
``````Sub PutAccountsInColumns()
Dim R As Long, C As Long, xB As Long, xF As Long, xG As Long
Dim Data As Variant, Accounts As Variant
Data = Range("A1", Cells(Rows.Count, "A").End(xlUp))
ReDim Accounts(1 To UBound(Data), 1 To 3)
For R = 1 To UBound(Data)
Select Case Right(Split(Data(R, 1))(0), 1)
Case "B"
xB = xB + 1
Accounts(xB, 2) = Data(R, 1)
Case "F":
xF = xF + 1
Accounts(xF, 1) = Data(R, 1)
Case "G":
xG = xG + 1
Accounts(xG, 3) = Data(R, 1)
End Select
Next
Range("C1:E" & UBound(Accounts)) = Accounts
End Sub``````

HOW TO INSTALL MACROs
------------------------------------
If you are new to macros, they are easy to install and use. To install it, simply press ALT+F11 to go into the VB editor and, once there, click Insert/Module on its menu bar, then copy/paste the above code into the code window that just opened up. That's it.... you are done. To use the macro, go back to the worksheet with your data on it and press ALT+F8, select the macro name (PutAccountsInColumns) from the list that appears and click the Run button. The macro will execute and perform the action(s) you asked for. If you will need to do this again in this same workbook, and if you are using XL2007 or above, make sure you save your file as an "Excel Macro-Enabled Workbook (*.xlsm) and answer the "do you want to enable macros" question as "yes" or "OK" (depending on the button label for your version of Excel) the next time you open your workbook.

Rick,

Wow thanks a bunch!!

Give this macro a try...
Code:
``````Sub PutAccountsInColumns()
Dim R As Long, C As Long, xB As Long, xF As Long, xG As Long
Dim Data As Variant, Accounts As Variant
Data = Range("A1", Cells(Rows.Count, "A").End(xlUp))
ReDim Accounts(1 To UBound(Data), 1 To 3)
For R = 1 To UBound(Data)
Select Case Right(Split(Data(R, 1))(0), 1)
Case "B"
xB = xB + 1
Accounts(xB, 2) = Data(R, 1)
Case "F":
xF = xF + 1
Accounts(xF, 1) = Data(R, 1)
Case "G":
xG = xG + 1
Accounts(xG, 3) = Data(R, 1)
End Select
Next
Range("C1:E" & UBound(Accounts)) = Accounts
End Sub``````

HOW TO INSTALL MACROs
------------------------------------
If you are new to macros, they are easy to install and use. To install it, simply press ALT+F11 to go into the VB editor and, once there, click Insert/Module on its menu bar, then copy/paste the above code into the code window that just opened up. That's it.... you are done. To use the macro, go back to the worksheet with your data on it and press ALT+F8, select the macro name (PutAccountsInColumns) from the list that appears and click the Run button. The macro will execute and perform the action(s) you asked for. If you will need to do this again in this same workbook, and if you are using XL2007 or above, make sure you save your file as an "Excel Macro-Enabled Workbook (*.xlsm) and answer the "do you want to enable macros" question as "yes" or "OK" (depending on the button label for your version of Excel) the next time you open your workbook.

asalman07,

Sample raw data:

Excel 2007
ABCDE
1Accounts
2180F - Unif/Printing/Forms and Supp
3420B - Maint Materials & Supplies
4430B - Inventory Support Fees
5490B - Uniforms Forms & Supplies
6530B - Printing and Duplication
7720G - Materials/Supplies
8570G - Inventory Support Fees
9700G - Office/Computer Supplies
10710G - Small Tools
11730G - Uniforms
12810G - Printing/Duplication
13
Sheet1

After the macro using four arrays in memory:

Excel 2007
ABCDE
1AccountsFBG
2180F - Unif/Printing/Forms and Supp180F420B720G
3420B - Maint Materials & Supplies430B570G
4430B - Inventory Support Fees490B700G
5490B - Uniforms Forms & Supplies530B710G
6530B - Printing and Duplication730G
7720G - Materials/Supplies810G
8570G - Inventory Support Fees
9700G - Office/Computer Supplies
10710G - Small Tools
11730G - Uniforms
12810G - Printing/Duplication
13
Sheet1

Please TEST this FIRST in a COPY of your workbook (always make a backup copy before trying new code, you never know what you might lose).

1. Copy the below code
3. Press the keys ALT + F11 to open the Visual Basic Editor
4. Press the keys ALT + I to activate the Insert menu
5. Press M to insert a Standard Module
6. Where the cursor is flashing, paste the code
7. Press the keys ALT + Q to exit the Editor, and return to Excel
8. To run the macro from Excel press ALT + F8 to display the Run Macro Dialog. Double Click the macro's name to Run it.

Code:
``````Sub GetAccounts()
' hiker95, 09/02/2014, ME802776
Dim a As Variant, c As Variant, d As Variant, e As Variant
Dim i As Long, cc As Long, dd As Long, ee As Long, n As Long, lr As Long
Application.ScreenUpdating = False
lr = Cells(Rows.Count, 1).End(xlUp).Row
a = Range("A1:A" & lr)
n = Application.CountIf(Columns(1), "*F -*")
ReDim c(1 To n, 1 To 1)
n = Application.CountIf(Columns(1), "*B -*")
ReDim d(1 To n, 1 To 1)
n = Application.CountIf(Columns(1), "*G -*")
ReDim e(1 To n, 1 To 1)
For i = 2 To lr
If InStr(a(i, 1), "F - ") Then
cc = cc + 1
c(cc, 1) = Left(a(i, 1), WorksheetFunction.Find(" - ", a(i, 1)) - 1)
ElseIf InStr(a(i, 1), "B - ") Then
dd = dd + 1
d(dd, 1) = Left(a(i, 1), WorksheetFunction.Find(" - ", a(i, 1)) - 1)
ElseIf InStr(a(i, 1), "G - ") Then
ee = ee + 1
e(ee, 1) = Left(a(i, 1), WorksheetFunction.Find(" - ", a(i, 1)) - 1)
End If
Next i
Columns("C:E").ClearContents
With Cells(1, 3).Resize(, 3)
.Value = Array("F", "B", "G")
.Font.Bold = True
.HorizontalAlignment = xlCenter
End With
Cells(2, 3).Resize(cc, 1).Value = c
Cells(2, 4).Resize(dd, 1).Value = d
Cells(2, 5).Resize(ee, 1).Value = e
Columns("C:E").AutoFit
Application.ScreenUpdating = True
End Sub``````

Before you use the macro with Excel 2007 or newer, save your workbook, Save As, a macro enabled workbook with the file extension .xlsm

Then run the GetAccounts macro.

asalman07,

Sample raw data:

Excel 2007
ABCDE
1Accounts
2180F - Unif/Printing/Forms and Supp
3420B - Maint Materials & Supplies
4430B - Inventory Support Fees
5490B - Uniforms Forms & Supplies
6530B - Printing and Duplication
7720G - Materials/Supplies
8570G - Inventory Support Fees
9700G - Office/Computer Supplies
10710G - Small Tools
11730G - Uniforms
12810G - Printing/Duplication
13

</tbody>
Sheet1

After the macro using four arrays in memory:

Excel 2007
ABCDE
1AccountsFBG
2180F - Unif/Printing/Forms and Supp180F420B720G
3420B - Maint Materials & Supplies430B570G
4430B - Inventory Support Fees490B700G
5490B - Uniforms Forms & Supplies530B710G
6530B - Printing and Duplication730G
7720G - Materials/Supplies810G
8570G - Inventory Support Fees
9700G - Office/Computer Supplies
10710G - Small Tools
11730G - Uniforms
12810G - Printing/Duplication
13

</tbody>
Sheet1

Please TEST this FIRST in a COPY of your workbook (always make a backup copy before trying new code, you never know what you might lose).

1. Copy the below code
3. Press the keys ALT + F11 to open the Visual Basic Editor
4. Press the keys ALT + I to activate the Insert menu
5. Press M to insert a Standard Module
6. Where the cursor is flashing, paste the code
7. Press the keys ALT + Q to exit the Editor, and return to Excel
8. To run the macro from Excel press ALT + F8 to display the Run Macro Dialog. Double Click the macro's name to Run it.

Code:
``````Sub GetAccounts()
' hiker95, 09/02/2014, ME802776
Dim a As Variant, c As Variant, d As Variant, e As Variant
Dim i As Long, cc As Long, dd As Long, ee As Long, n As Long, lr As Long
Application.ScreenUpdating = False
lr = Cells(Rows.Count, 1).End(xlUp).Row
a = Range("A1:A" & lr)
n = Application.CountIf(Columns(1), "*F -*")
ReDim c(1 To n, 1 To 1)
n = Application.CountIf(Columns(1), "*B -*")
ReDim d(1 To n, 1 To 1)
n = Application.CountIf(Columns(1), "*G -*")
ReDim e(1 To n, 1 To 1)
For i = 2 To lr
If InStr(a(i, 1), "F - ") Then
cc = cc + 1
c(cc, 1) = Left(a(i, 1), WorksheetFunction.Find(" - ", a(i, 1)) - 1)
ElseIf InStr(a(i, 1), "B - ") Then
dd = dd + 1
d(dd, 1) = Left(a(i, 1), WorksheetFunction.Find(" - ", a(i, 1)) - 1)
ElseIf InStr(a(i, 1), "G - ") Then
ee = ee + 1
e(ee, 1) = Left(a(i, 1), WorksheetFunction.Find(" - ", a(i, 1)) - 1)
End If
Next i
Columns("C:E").ClearContents
With Cells(1, 3).Resize(, 3)
.Value = Array("F", "B", "G")
.Font.Bold = True
.HorizontalAlignment = xlCenter
End With
Cells(2, 3).Resize(cc, 1).Value = c
Cells(2, 4).Resize(dd, 1).Value = d
Cells(2, 5).Resize(ee, 1).Value = e
Columns("C:E").AutoFit
Application.ScreenUpdating = True
End Sub``````

Before you use the macro with Excel 2007 or newer, save your workbook, Save As, a macro enabled workbook with the file extension .xlsm

Then run the GetAccounts macro.

Hiker thanks a lot. Ricks code did the job. I was looking/hoping for a formula solution but the vba code produced the desired results. Thank you!!

asalman07,

I thought that you were looking for the leading text in each cell in column A, and, not the entire string.

Thanks for the feedback.

You are very welcome.

And, come back anytime.

### Forum statistics

1,221,053
Messages
6,157,638
Members
451,426
Latest member
VinnyDoesntKnowExcelCode

### We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.

### Which adblocker are you using?

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

### Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

### Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back