You are here:

Excel/Transpose multiple fields from vertical to horizontal

Advertisement


Question
Transpose with a twist
Transpose with a twist  
QUESTION: Hello Tom,
I have a transposition question, but with a twist.
Please see the attached image.
I think that explains everything clearly.
I have considered fancy lookups, index/match, and vba - all to no avail.
I'm not an expert vba guy like you, and I'm guessing this definitely needs a vba solution.
Thanks for your efforts, Tom !
- Al Baker

ANSWER: Al,

I typed in the data you show in column A and B in the activesheet and ran this macro:

Sub ABC()
Dim f As Range, rw As Long, cell As Range
Set f = Range("A1", Cells(Rows.Count, 1).End(xlUp)).SpecialCells(xlConstants)
rw = 1
For Each cell In f
  Select Case Trim(cell.Value)
    Case "f1"
      If Cells(Cells.Rows.Count, "D").End(xlUp).Row = rw Then rw = rw + 1
      Cells(rw, "D").Value = cell.Offset(0, 1).Value
    Case "f2"
      Cells(rw, "E").Value = cell.Offset(0, 1).Value
    Case "f3"
      Cells(rw, "F").Value = cell.Offset(0, 1).Value
    Case "f4"
      Cells(rw, "G").Value = cell.Offset(0, 1).Value
    Case Else
  End Select
Next
End Sub

It produced the data in columns D:G that you show.  (without the headers in D1:G1.  You can type those in).

So I literally looking for f1, f2, f3 and f4.  Change the code to match whatever field names you will have in column A.

--
Regards,
Tom Ogilvy


---------- FOLLOW-UP ----------

Problem with transpose
Problem with transpose  
QUESTION: Tom,
Your solution was BRILLIANT!
However, there seems to be one glitch:
In the attached image, you can see that I added another (5th) record to the list in cols A-B.  That 5th record has the fields switched around, i.e. there are not in the usual order (that is what is in the actual data.)
You can see that the populated fields in cols D-G don't populate right, below the 3rd record.  It's "almost" there, but you can see how 'phone5' should have been in the 5th record, but instead it overwrote the 4th record.
Hope this makes sense.
Thanks again Tom !

ANSWER: Al,
> Hope this makes sense.
It doesn't make sense that that is a possibility.  I am pretty much limited to writing the algorithm based on the problem presented.  Since you showed only ordered data (ordered by field within a company), I used that assumption in deriving my approach.  Since this appears to be a possibility your sample data was not a good representation of the true situation.  

Situation: You now show a situation which was not part of your original question.  You now show it can't be assumed that the data is ordered by field within a company.  I only include these comments so you understand that if you choose to illustrate the parameters of the problem by showing a sample and asking me to figure out the parameters, I may make assumptions that are warranted by the sample, but may not actually be true.

So now I have to make a determination how my code is to determine what data goes together.  From looking at your example, it appears that each company is separated by at least one row of data that does not have a field name in column A.  Further I assume that all companies will have fields f1, f2 and f3.  This code works for those assumptions:


I can eliminate the part of the assumption about f1, f2 and f3 and only assume that if I have Sub ABC()
Dim f As Range, rw As Long, cell As Range
Dim v As Variant
ReDim v(1 To 1, 1 To 4)
Set f = Range("A1", Cells(Rows.Count, 1).End(xlUp).Offset(1, 0))
rw = 1
For Each cell In f
  Select Case Trim(cell.Value)
    Case "f1"
      v(1, 1) = cell.Offset(0, 1).Value
    Case "f2"
      v(1, 2) = cell.Offset(0, 1).Value
    Case "f3"
      v(1, 3) = cell.Offset(0, 1).Value
    Case "f4"
      v(1, 4) = cell.Offset(0, 1).Value
    Case Else
      If Not IsEmpty(v(1, 1)) And Not IsEmpty(v(1, 2)) And Not IsEmpty(v(1, 3)) Then
        rw = rw + 1
        Cells(rw, "D").Resize(1, 4) = v
        ReDim v(1 To 1, 1 To 4)
      End If
  End Select
Next
End Sub
recorded an f1 field and then encountered a something that is neither f1, f2, f3, f4 then the company has ended and I can write the record.  This assume that the standard field are always contiguous but not necessarily ordered.

Sub ABC()
Dim f As Range, rw As Long, cell As Range
Dim v As Variant
ReDim v(1 To 1, 1 To 4)
Set f = Range("A1", Cells(Rows.Count, 1).End(xlUp).Offset(1, 0))
rw = 1
For Each cell In f
  Select Case Trim(cell.Value)
    Case "f1"
      v(1, 1) = cell.Offset(0, 1).Value
    Case "f2"
      v(1, 2) = cell.Offset(0, 1).Value
    Case "f3"
      v(1, 3) = cell.Offset(0, 1).Value
    Case "f4"
      v(1, 4) = cell.Offset(0, 1).Value
    Case Else
      If Not IsEmpty(v(1, 1)) Then
        rw = rw + 1
        Cells(rw, "D").Resize(1, 4) = v
        ReDim v(1 To 1, 1 To 4)
      End If
  End Select
Next
End Sub


So if the assumptions associated with either of the procedures are not applicable, then you can expect to end up with missing rows or mixed up rows.  If you find that to be the case then you need to layout what patterns need to be accounted for and how data can be grouped by the rows to be written (by company as an example).

--
Regards,
Tom Ogilvy



---------- FOLLOW-UP ----------

4Tom3
4Tom3  

4Tom4
4Tom4  
QUESTION: Tom - you are absolutely correct andn I apologize for not being precise and causing you to make assumptions which were very reasonable given what I had provided.  When you are not given the "complete" picture, it causes you to spend more time than otherwise and I know your time is very valuable.  I was trying to "simplify" the actual example but in doing so, I left out important information which you needed.
Again, please accept my apologies.

I will be more clear.  Please see the attached - there are 2 images.
The first re-states my example and objective, along with a bit of background.
The second shows the result of running your solution - which is VERY CLOSE.
You wrote your code so well that I thought I could edit it in order to accommodate more fields.  I thought I edited it properly by putting in "field one" rather the f1, and by changing 4 to 5, but perhaps I did something wrong.

Your code which I modified is below:
Sub ABC()
Dim f As Range, rw As Long, cell As Range
Dim v As Variant
ReDim v(1 To 1, 1 To 5)
Set f = Range("A1", Cells(Rows.Count, 1).End(xlUp).Offset(1, 0))
rw = 2
For Each cell In f
 Select Case Trim(cell.Value)
   Case "field one"
     v(1, 1) = cell.Offset(0, 1).Value
   Case "field two"
     v(1, 2) = cell.Offset(0, 1).Value
   Case "field three"
     v(1, 3) = cell.Offset(0, 1).Value
   Case "field four"
     v(1, 4) = cell.Offset(0, 1).Value
   Case "field five"
     v(1, 5) = cell.Offset(0, 1).Value
   Case Else
     If Not IsEmpty(v(1, 1)) Then
       rw = rw + 1
       Cells(rw, "D").Resize(1, 5) = v
       ReDim v(1 To 1, 1 To 5)
     End If
 End Select
Next
End Sub

Thank you again Tom for your incredible expertise, promptness, and patience.
- Al

Answer
Al,

I am pretty much done with typing in sample data depicting various situations.

Also, it is not clear what you mean be actual fields in row 1 and the use of Field One and Field Two and so forth.

If you want to send me a sample input file that represents exactly what an input file would look like, I can take a look and see if I can adapt the code.

send it to twogilvy@msn.com

--
Regards,
Tom Ogilvy  
About Excel
This topic answers questions related to Microsoft Excel spreadsheet (or workbook) stand-alone or Mircrosoft Office Excel including Excel 2003, Excel 2007, Office 2000, and Office XP. You can get Excel help on Excel formulas(or functions), Excell macros, charting in Excel, advanced features, and the general use of Excel. This does not provide a general Excel tutorial nor the basics of using a spreadsheet. It provides specific answers to using Microsoft Excel only. If you do not see your Excel question answered in this area then please ask an Excel question here

Excel

All Answers


Answers by Expert:


Ask Experts

Volunteer


Tom Ogilvy

Expertise

Selected as an Excel MVP by Microsoft since 1999. Answering Excel questions in Allexperts since its inception in 2001. Able to answer questions on almost all aspects of Excel's internal capabilities. If seeking a VBA solution, please specify that in your question itself so I give you the answer you want. [Excel has weak protection - if you are distributing an application, I don't answer questions on how to protect your project from your users.]

Experience

Extensive experience.

Education/Credentials
Master of Science (MS) degree Operations Research (ORSA)

Awards and Honors
Microsoft MVP in Excel.

©2016 About.com. All rights reserved.