Rearrange data into Columns in same row

[mypetduke]

Okay this is for the bright ones out there, or is it easy?

I have a lot of text in cells all scattered along the same Row but it's not
aligned into the same Column. The macro can know easily what column it goes
into (again without changing the row which all stays together) because the
first part of the text is named like the Column. For example if the text says
"Name John" then it needs to be placed in the Column that says "Name."

So in other words the Macro would take all the contents of this cell just
because it starts with "Name" and place the whole thing "Name John" into the
Column that says "Name" without moving it outside the original row. There
are about 30 different Columns and they change for each project/worksheet so
I need a Macro where I can choose the new Column names and the text is
scanned and placed into the respective named columns.
Is this too tough a job for this site?

Example:

Text before Sorting

Name Car House
Name John Car Chevy House Ranch
Car Ford Name Mary a blank cell
House Blue Car Chrysler Name Bob

After Macro Sort Column Rearrange

Name Car House
Name John Car Chevy House Ranch
Name Mary Car Ford an actual blank cell (nothing
here at all)
Name Bob Car Chrysler House Blue

As you can see sometimes there is no value for a column or row and that's
okay and should stay blank since it has no name that matches the Column Name

So I should be able to make a list

1. A
2. B
3. C
4. etc.

and the Macro/code would know that the terms in the list are the new Columns
which means, too, it is also the beginning words of the text in the cells to
be rearranged.

 

[spongebab]

Saw your earlier post where someone tried to help you. I think the point of
this site is for people that want to learn VBA to get help from more
experienced users. Not so much to get someone else to do your work for you.
Just sayin'...

 

[Jacob Skaria]

Try with the below and feedback. Number of columns will be picked up...Adjust
the lastRow which is currently 10.


Sub AlignDataAsPerHeader()

Dim lngRow As Long
Dim lngCol As Long
Dim lngTemp As Long
Dim lngLastRow As Long
Dim arrHeader() As Variant
Dim arrTemp() As Variant


'Getting headers
lngRow = 1
'lngLastRow = Sheets("Sheet1").UsedRange.Rows.Count
lngLastRow = 10
Do While Cells(1, lngRow) <> ""
ReDim Preserve arrHeader(lngRow)
arrHeader(lngRow) = Trim(Cells(1, lngRow))
lngRow = lngRow + 1
Loop

For lngRow = 2 To lngLastRow
ReDim arrTemp(UBound(arrHeader))
'Aligning data with reference to header
For lngCol = 1 To UBound(arrHeader)
For lngTemp = 1 To UBound(arrHeader)
If Cells(lngRow, lngTemp) Like arrHeader(lngCol) & "*" Then
arrTemp(lngCol) = Cells(lngRow, lngTemp): Exit For
End If
Next
Next

'Write aligned values
For lngCol = 1 To UBound(arrHeader)
Cells(lngRow, lngCol) = arrTemp(lngCol)
Next
Next

End Sub



If this post helps click Yes

 

[mypetduke]

Well, I think you're right about this site, mostly. It seems sometimes people
make presumptions based on uninformed impressions then leave their emotional
sarcasm for others to read without full disclosure of their own motive. If
you want to help, please do. If not please leave your unsolicited comments to
yourself. And have a great day!

 

[mypetduke]

Thanks for your effort but it's not working. Or, perhaps we just
miscommunicated and it could work if we both understood each other better.
Out of respect for yoour time and my integrity, prompted by another posted
remark, please know I have a lot of attempted code that I am not sharing
because after so many different attemps I think they are feeding continuous
erros rather than inviting a sorely needed fresh new know-how-to-do-it
approach.
Things are moving and also disappearing. I tried playing withiyour vode too
but no luck. Again, it may be in my explanation. Care to discuss? The
project is really not important anymore. It's become a challenge for my
novice learning curve and I just can't shake it - you must know what I mean!

 

[mypetduke]

Jacob - please disregard my former msg. You did it! Great job! Hey, I got a
Starbucks gift certificate ifor $5.00 if you want it (seriously and don't
mean it as an insult at all)! Appreciate it much! Would still love to chat if
you could.

 

[Jacob Skaria]

Sure...Great to hear that it worked...Was quite interesting to solve your
query..

Keep in touch at jacs_jay(aty).
Replace 'at' with @ and last 'y' withyahoodotcom

If this post helps click Yes