Retrieve 1 Column of Data into 3 different columns

A

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 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.
Sort by date Sort by votes
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
Rick,

Wow thanks a bunch!!

Rick Rothstein said:
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.
Click to expand...
 
Upvote 0
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
hiker95 said:
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.
Click to expand...

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
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
You must log in or register to reply here.

Forum statistics

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

Share this page

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
Back
Top