Retrieve 1 Column of Data into 3 different columns

asalman07

Active Member
Joined
Jun 12, 2013
Messages
325
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.

Thank you in advance for your help!

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

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

Excel Facts

Which Excel functions can ignore hidden rows?
The SUBTOTAL and AGGREGATE functions ignore hidden rows. AGGREGATE can also exclude error cells and more.

Rick Rothstein

MrExcel MVP
Joined
Apr 18, 2011
Messages
38,150
Office Version
  1. 2019
  2. 2010
Platform
  1. Windows
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.
 
Upvote 0

asalman07

Active Member
Joined
Jun 12, 2013
Messages
325
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.
 
Upvote 0

hiker95

Well-known Member
Joined
Apr 8, 2009
Messages
17,649
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
2. Open your NEW workbook
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.
 
Upvote 0

asalman07

Active Member
Joined
Jun 12, 2013
Messages
325
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

<colgroup><col style="width: 25pxpx"><col><col><col><col><col></colgroup><thead>
</thead><tbody>
</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

<colgroup><col style="width: 25pxpx"><col><col><col><col><col></colgroup><thead>
</thead><tbody>
</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
2. Open your NEW workbook
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!!
 
Upvote 0

hiker95

Well-known Member
Joined
Apr 8, 2009
Messages
17,649
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.

Glad you found a solution.

And, come back anytime.
 
Upvote 0

Forum statistics

Threads
1,190,918
Messages
5,983,578
Members
439,852
Latest member
balasat

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.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

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

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

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
Top