You are here:

- Home
- Computing/Technology
- Business Software
- Excel
- Transpose multiple fields from vertical to horizontal

Advertisement

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 ----------

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 ----------

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

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

- Add to this Answer
- Ask a Question

Rating(1-10) | Knowledgeability = 10 | Clarity of Response = 10 | Politeness = 10 |

Comment | I have used this service in the past and without a doubt, Tom is at the highest level of professionalism, expertise, and responsiveness. Not only do his solutions work, they are elegant and brief. Tom was extremely responsive when I had to send a couple of follow-ups which contradicted my original request to him; despite that, he persevered and provided a great solution. Tom is the best. |

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

Answers by Expert:

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.]

Extensive experience. **Education/Credentials**

Master of Science (MS) degree Operations Research (ORSA)**Awards and Honors**

Microsoft MVP in Excel.