vb code for excel

I have a spreadsheet that has 7 columns.  column 1 = acct    columns 2 - 7  (any one of 6 types of transactions with amount of transaction)

the columns are not organized by any logic.  they all contain transactions associated by the account identified in column a with a keyword

I need the row data to stay consistent but add columns that have the transactions organized by keyword in new, properly identified columns

this seems pretty hard but an example of the spreadsheet is posted.

The actual spreadsheet I am working with has thousands of rows.
Who is Participating?

[Product update] Infrastructure Analysis Tool is now available with Business Accounts.Learn More

I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

Saurabh Singh TeotiaCommented:

Not sure you want to do this by macro only..but here is a formula solution for you..Highlighted in yellow cells which does what you are looking for and then simply you can drag this formula to next row...


Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
Martin LissOlder than dirtCommented:
Will each customer always have 6 columns of data with one cell for each of the listed keywords and only those keywords?
Sub Q_28738329()
    Dim rng As Range
    Dim rngThing As Range
    Dim wks As Worksheet
    Dim strValue As String
    Dim oDic As Object
    Set oDic = CreateObject("scripting.dictionary")
    Set wks = ActiveSheet
    Set rng = wks.Range("A2")
    Set rng = rng.End(xlToRight).End(xlToRight)
    For Each rng In wks.Range(rng, rng.End(xlToRight))
        If oDic.exists(rng.Value) Then
            MsgBox "Duplicate header encountered (" & rng.Value & ")"
            Exit Sub
            oDic(rng.Value) = rng.Column
        End If
    Set rng = wks.Range("B3")
        For Each rngThing In wks.Range(rng, rng.End(xlToRight))
            strValue = Split(rngThing.Value, " ")(0)
            If oDic.exists(strValue) Then
                wks.Cells(rngThing.Row, oDic(strValue)).Value = rngThing.Value
                MsgBox "Target column key (" & rngThing.Value & ") does not exist"
                Exit Sub
            End If
        Set rng = rng.Offset(1)
    Loop Until Len(rng.Value) = 0
End Sub

Open in new window

Introduction to R

R is considered the predominant language for data scientist and statisticians. Learn how to use R for your own data science projects.

Martin LissOlder than dirtCommented:
Here is a different approach which assumes that columns I through P don't exist. It also has the side affect of sorting the new columns horizontally. The code for the horizontal sort is based on Dave Peterson's "SortLotteryRows" sub posted on the Contextures blog.

Sub BuyFruit()

Dim colFruit As New Collection
Dim cel As Range
Dim rng As Range
Dim strFruit As String
Dim intCol As Integer
Dim iRow As Long
Dim FirstRow As Long
Dim LastRow As Long

With ActiveSheet
FirstRow = 3 ' change to 2 if row 1 (the "Original Table" row) is removed
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row

Set rng = Range("B" & FirstRow & ":G" & Range("B1048576").End(xlUp).Row)
' Copy the data to the "Added Columns" area
rng.Copy Destination:=rng.Offset(0, 7)

' Sort the new columns horizontally.
For iRow = FirstRow To LastRow
    With .Cells(iRow, "I").Resize(1, 6)
        .Sort Key1:=.Columns(1), _
        Order1:=xlAscending, _
        Header:=xlNo, _
        OrderCustom:=1, _
        MatchCase:=False, _
    End With
Next iRow
End With

' Create a list of unique fruit names to be used as column headers
Set rng = Range("I" & FirstRow & ":N" & Range("I1048576").End(xlUp).Row)
For Each cel In rng
    On Error Resume Next
        strFruit = Split(cel.Value, " ")(0)
        colFruit.Add strFruit, strFruit
    On Error GoTo 0

' Add the new column headers
For intCol = 1 To colFruit.Count
    Cells(FirstRow - 1, intCol + 8) = colFruit(intCol)
End Sub

Open in new window

Very nice, Martin.

If the problem changes to moving the data in place, instead of to the right, I would replace the in-place sort method with a dictionary retrieval by ordered key.
Martin LissOlder than dirtCommented:
Thanks aikimark.

I would replace the in-place sort method with a dictionary retrieval by ordered key.
Easy for you to say:)
Martin LissOlder than dirtCommented:
I'm glad I was able to help.

In my profile you'll find links to some articles I've written that may interest you.
Marty - MVP 2009 to 2015, Experts-Exchange Top Expert Visual Basic Classic 2012 to 2014
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Microsoft Excel

From novice to tech pro — start learning today.