Sorting and lining up data into columns based off content

[Gast]

I have imported a large group of data and would like to sort it into some
sort of order. Each row has 20-30 cells of data. All of the data is in the
same order, but some of the rows are lacking some of the cells of data. I'd
like to line up all the same types of data and insert either a blank cell or
a "n/a" type value into the rows in the proper spot to align the data. I
guess the best way is to give an example.

Here's the data I have:

Name | Address | Phone | B-Day |
Name | Phone | B-Day |
Name | Address | B-Day |

Here's what I want to end up with:

Name | Address | Phone | B-Day |
Name | --------- | Phone | B-Day |
Name | Address | ------- | B-Day |

Each of the different types of data are identifiable based off the first
part of the string. For example, all address cells start with "Address: " and
all the phone cells start with "Phone: ".

Thanks for the help in advance ^_^

 

[Dave Peterson]

If you shared the 20-30 prefixes that identify each field, then it would make it
easier to help.

In fact, you may want to prioritize the list so that your output is in the order
that you want.

1. Name:
2. Address:
3. Phone:
4. b-day:
5. etc, etc, etc

 

[JLatham]

You need to do a little setup for the code below to work. It needs a
'header' row in row 1. In that row are the labels that match the data in
proper sequence, as:
A B C D ..... U
1 Name Address Phone B-Day LastEntry

Make sure those entries are spelled, or misspelled, exactly as they are in
your data entries, but do not include the colon with them.

Then your data starts at A2 and continues down/across the sheet. And there
is nothing below the last name in column A, and nothing to the right of the
last entry in the Header row (row 1). This does also assume that each entry
has a Name entry.

Next, make a copy of that sheet - in case my best laid plan goes awry, at
least you'll only have messed up a copy, not the source data. It worked for
me with the very limited data you provided, with a little extra added to it
to test with.

With the copy sheet selected, use Tools | Macro | Macros to run this code
once you've got it in the workbook. To put it in your workbook, press
[Alt]+[F11] to open the VB Editor, then choose Insert | Module from the VBE
menu. Copy the code below and paste it into the module and close the VB
Editor. Ready to rock and roll!

Sub RightShiftData()
'assumes a full header row in row 1
'with 'tags' used for the fields in the data area
'also assumes each entry has a Name
'and that if there's something in the last field/column
'then that row needs no attention
'and that each entry in the data is identified by a
'unique word or phrase that ends with a colon [:]
'
Dim lastRow As Long
Dim lastCol As Integer ' only dealing with 20 or so
Dim baseCell As Range
Dim rOffset As Long ' for looping
Dim cOffset As Integer ' for looping
Dim hOffset As Integer 'for looping in header row
Dim fieldName As String

If Val(Left(Application.Version, 2)) < 12 Then
'in Excel 2003 or earlier
lastRow = Range("A" & Rows.Count).End(xlUp).Row
Else
'in Excel 2007 (or later?)
lastRow = Range("A" & Rows.CountLarge).End(xlUp).Row
End If
Set baseCell = Range("A1")
lastCol = baseCell.Offset(0, _
Columns.Count - 1).End(xlToLeft).Column
Application.ScreenUpdating = False ' for performance
For rOffset = 1 To lastRow - 1
If IsEmpty(baseCell.Offset(rOffset, lastCol - 1)) Then
'have work to do, nothing in far right column
For cOffset = lastCol - 1 To 1 Step -1
If Not IsEmpty(baseCell.Offset(rOffset, cOffset)) Then
'may need to move this one
'dig out the field name, assumes field name ends
'with a colon [:] character.
fieldName = UCase(Trim(Left(baseCell.Offset(rOffset, cOffset), _
InStr(baseCell.Offset(rOffset, cOffset), ":") - 1)))
If UCase(Trim(baseCell.Offset(0, cOffset))) <> fieldName Then
'must move it, not in proper column
For hOffset = cOffset To lastCol - 1
If UCase(Trim(baseCell.Offset(0, hOffset))) = fieldName Then
baseCell.Offset(rOffset, hOffset) = _
baseCell.Offset(rOffset, cOffset)
'erase old entry
baseCell.Offset(rOffset, cOffset).ClearContents
End If
Next ' find column loop
End If ' ck for already in proper column
End If
Next ' cOffset loop
End If
Next ' rOffset loop
Application.ScreenUpdating = True
End Sub