PDA

View Full Version : Solved: Transposing Data with Non-Standard Fields



willhh3
01-14-2011, 05:24 PM
I have kind of an odd and somewhat complicated question. I get a report via e-mail of data that is listed all in one column. I’d like to take this data, paste it Excel and then do some coding that will transpose the data to multiple columns. I have no problem figuring out the transpose part…the catch is each block of data isn’t always the same. So I want Excel to plan for a fixed number of columns, but to put the data in the correct cell when the data is present or to skip the cell when it is not. I’m attaching a sample which should clarify what I’m trying to say here in words.

Thanks in advance for any help.

Whh

stanleydgrom
01-14-2011, 09:47 PM
willhh3,

Detach/open workbook willhh3 - VE35706 - SDG15.xlsm and run macro ReorgData.


Have a great day,
Stan

willhh3
01-15-2011, 07:31 AM
WOW! Perfect! Thanks for the quick and helpful response.

Whh

willhh3
01-24-2011, 02:28 PM
Not sure if I should open this in a new thread, since it is a contination of the question that was answered by stanleydgrom.

My data has changed a little with an extra line of information. So the spreadheet with the solution that stanleydgrom supplied should still be vaild for the example. However, each block of data has on extra cell of data at the top: a number dash status.

What I would like to do is: Add this extra line to the solution that standleydgrom provided spliting the number into it's own cell and the remaining data into next cell.

One of the issues I ran into when trying to figure it out was the use of multiple dashes in the data.

I'm attaching an updated sample spreadsheet with the code that was provided.

Thanks in advance.
Whh

mdmackillop
01-24-2011, 03:56 PM
Sub Test()
Dim i As Long, j As Long, k As Long
Dim Rng As Range
Dim Head As Range
Dim c As Range
Dim cel As Range
Dim Data As Range

k = 3
Set Head = Cells(3, 3).Resize(, 12)
Head = Array("Act #", "Status", "First Name", "Last Name", "Address 1", "Address 2", "City", "State", "Zip", "Home", "Cell", "Work")
Set Rng = Range(Cells(2, 1), Cells(Rows.Count, 1).End(xlUp)).SpecialCells(xlCellTypeBlanks)
For Each cel In Rng
k = k + 1
Set Data = cel.Offset(1).CurrentRegion
'Data.Select
Cells(k, 3) = Split(Data(1), "-")(0)
Cells(k, 4) = Split(Data(1), "-")(1) & " - " & Split(Data(1), "-")(2)
For i = 2 To Data.Cells.Count
Set c = Head.Find(Split(Data(i), ":")(0))
If Not c Is Nothing Then
Cells(k, c.Column) = Split(Data(i), ":")(1)
End If
Next

Next
End Sub

stanleydgrom
01-24-2011, 05:00 PM
willhh3,

Detach/open workbook rowwillhh3 - VE35706 - V2 - SDG15.xlsm and run macro ReorgDataV2.


Have a great day,
Stan

willhh3
01-24-2011, 05:33 PM
Thanks to you both for the quick response. It's so nice to have a resource like this to get help and to help us newbies learn.

mdmackkillop: I tried to run your code and got a run-time error/sub-script out of range. Not sure as to the why, but it also put some of the data we want to strip out in the first cell. I'm attaching a screen shot so you can see. It throws the error on the next step. I'd be interested in seeing what you discover, as a learning point for me.

stanleydgrom: I downloaded the fiile and ran the macro and all seemed to work just like I wanted. Perfect!

Once again, thanks to the both of you for the help!
Whh

mdmackillop
01-24-2011, 06:00 PM
Can you post your test data?

mdmackillop
01-24-2011, 06:15 PM
However, each block of data has on extra cell of data at the top: a number dash status.
The sample in your picture does not appear to follow this rule, so the code will fail.

willhh3
01-24-2011, 07:23 PM
The test data is in the earlier posts. I think I have what I need if you don't want to keep poking at it. Thanks, though!

willhh3
01-26-2011, 04:44 PM
/sigh

Sorry to have to keep asking questions on this same set of data. The solutions have been perfect and I’ve been able to easily take the simple sample and translate it to meet my needs.

I discovered today that the sample I gave you on the last round wasn’t quite right. I’m referring to the first cell in each block of data. The code you gave me works fine when there are two dashes in the cell (which is most of the time), but I’ve come across a few instances where there is only one dash. I tried commenting out one half of the code and then the other and it works fine. Now I just need it to account for both situations. I’ve tried working with an If then else statement, but can’t seem to get it to work for me. I’m attaching an updated sample and again appreciate your willingness to help a newbie through this.

Whh

mdmackillop
01-26-2011, 05:11 PM
Inconsistent data is the bane of us all! This should split off the data before the first (or only) dash.

Sub Test()
Dim i As Long, j As Long, k As Long
Dim Rng As Range
Dim Head As Range
Dim c As Range
Dim cel As Range
Dim Data As Range

k = 3
Set Head = Cells(3, 3).Resize(, 12)
Head = Array("Act #", "Status", "First Name", "Last Name", "Address 1", "Address 2", "City", "State", "Zip", "Home", "Cell", "Work")
Set Rng = Range(Cells(2, 1), Cells(Rows.Count, 1).End(xlUp)).SpecialCells(xlCellTypeBlanks)
For Each cel In Rng
k = k + 1
j = 2
Set Data = cel.Offset(1).CurrentRegion
'Data.Select
If InStr(1, Data(1), "-") > 0 Then
Cells(k, 3) = Split(Data(1), "-")(0)
Cells(k, 4) = Right(Data(1), Len(Data(1)) - Len(Cells(k, 3)) - 2)
Else
j = 1
End If
For i = j To Data.Cells.Count
Set c = Head.Find(Split(Data(i), ":")(0))
If Not c Is Nothing Then
Cells(k, c.Column) = Split(Data(i), ":")(1)
End If
Next

Next
End Sub

stanleydgrom
01-26-2011, 06:55 PM
willhh3,


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, by highlighting the code and pressing the keys CTRL + C
2. Open your 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 by pressing the keys CTRL + V
7. Press the keys ALT + Q to exit the Editor, and return to Excel
8. To run the macro from Excel, open the workbook, and press ALT + F8 to display the Run Macro Dialog. Double Click the macro's name to Run it.





Option Explicit
Sub ReorgDataV3()
' stanleydgrom, 01/26/2011
' http://www.vbaexpress.com/forum/showthread.php?t=35706
Dim AArea As Range, SR As Long, NR As Long
Dim c As Range, Sp, s As Long, H As String
Application.ScreenUpdating = False
Columns("C:N").Clear
Range("C1:N1") = [{"Act #","Status","First Name","Last Name","Address1","Address2","City","State","Zip","Home","Cell","Work"}]
For Each AArea In Range("A1", Range("A" & Rows.Count).End(xlUp)).SpecialCells(xlCellTypeConstants).Areas
With AArea
NR = Range("C" & Rows.Count).End(xlUp).Offset(1).Row
For Each c In AArea
SR = .Row
Sp = Split(Trim(Range("A" & SR)), " - ")
Range("C" & NR) = Sp(0)
If UBound(Sp) = 1 Then
Range("D" & NR) = Sp(1)
Else
H = ""
For s = 1 To UBound(Sp)
H = H & Sp(s) & " - "
Next s
If Right(H, 3) = " - " Then H = Left(H, Len(H) - 3)
Range("D" & NR) = H
End If
If InStr(Trim(c), "First Name:") > 0 Then
Sp = Split(Trim(c), ": ")
Range("E" & NR) = Sp(1)
ElseIf InStr(c, "Last Name:") > 0 Then
Sp = Split(Trim(c), ": ")
Range("F" & NR) = Sp(1)
ElseIf InStr(c, "Address 1:") > 0 Then
Sp = Split(Trim(c), ": ")
Range("G" & NR) = Sp(1)
ElseIf InStr(c, "Address 2:") > 0 Then
Sp = Split(Trim(c), ": ")
Range("H" & NR) = Sp(1)
ElseIf InStr(c, "City:") > 0 Then
Sp = Split(Trim(c), ": ")
Range("I" & NR) = Sp(1)
ElseIf InStr(c, "State:") > 0 Then
Sp = Split(Trim(c), ": ")
Range("J" & NR) = Sp(1)
ElseIf InStr(c, "Zip:") > 0 Then
Sp = Split(Trim(c), ": ")
Range("K" & NR) = Sp(1)
ElseIf InStr(c, "Home:") > 0 Then
Sp = Split(Trim(c), ": ")
Range("L" & NR) = Sp(1)
ElseIf InStr(c, "Cell:") > 0 Then
Sp = Split(Trim(c), ": ")
Range("M" & NR) = Sp(1)
ElseIf InStr(c, "Work:") > 0 Then
Sp = Split(Trim(c), ": ")
Range("N" & NR) = Sp(1)
End If
Next
End With
Next AArea
Columns("C:N").AutoFit
Application.ScreenUpdating = True
End Sub




Then run the ReorgDataV3 macro.


Have a great day,
Stan

willhh3
01-26-2011, 07:06 PM
Once again I'm indebted to you both for your assistance. I like seeing different ways to tackle the issue...it helps me learn. I'll experiment with them in the morning!

Whh3