98.7% Of all customers recommend us, we're so confident about our results we publish all reviews and stats
View Live Stats View ReviewsForum home » Delegate support and help forum » Microsoft Excel VBA Training and help » Transpose Macro
Transpose Macro
Resolved · Urgent Priority · Version 2007
Krishan has attended:
Excel Intermediate course
Excel Advanced course
PowerPoint Intermediate Advanced course
Excel Advanced - Formulas & Functions course
Excel Intermediate course
Excel Advanced course
Transpose Macro
Hi All
I have a list of data re-occuring format, similar data like in appendix 1 (below), this will be in "column A" of excel for about 1000 rows. I needed to write a macros to transpose this data. So I typed in the macro in Appendix 2 (below).
The problem:
I want to write a rule that instructs when a new transposition should take place instead of having it say "every 5 rows" as it might be 6 rows or 7 rows.. I would like to say "Transapose a new section after Telephone number"
Please could you help me?
Krishan
Appendix 1
Name:
Address
Qualification
Age
Telephone No
Name:
Address
Qualification
Age
Telephone No
Name:
Address
Qualification
Age
Telephone No
Name:
Address
Qualification
Age
Telephone No
Appendix 2.
Sub Transpose()
Dim a, w(), i As Long, j As Long, c As Integer
a = Range([a1], [a500000].End(xlUp))
ReDim w(1 To UBound(a, 1), 1 To 5)
j = 1
For i = 1 To UBound(a, 1)
c = 1 + (i - 1) Mod 5: w(j, c) = a(i, 1)
If c = 5 Then j = j + 1
Next i
[c1].Resize(j, 5) = w
End Sub
RE: Transpose Macro
Hi Krishan
Thanks for getting in touch.
Where you have references to "5" in your code, you should declare a variable instead.
This number can then be calculated and inserted in your code each time you need to reference it.
Kind regards
Gary Fenn
Microsoft Office Specialist Trainer
Tel: 0207 987 3777
Best STL - https://www.stl-training.co.uk
98%+ recommend us
London's leader with UK wide delivery in Microsoft Office training and management training to global brands, FTSE 100, SME's and the public sector
RE: Transpose Macro
Hi thank you for getting back to me.
That didnt work.
I replaced "Telephone No" in place of the number of rows I wanted to start a new transposition.
So in the macro below I am trying to say after the word "Telephone No" transpose the next rows in the column until you see the words "Telephone No" again in which case after this start a new transposition.
Is this what it is saying?
Sub Transpose()
Dim a, w(), i As Long, j As Long, c As Integer
a = Range([a1], [a500000].End(xlUp))
ReDim w(1 To UBound(a, 1), 1 To Telephone No)
j = 1
For i = 1 To UBound(a, 1)
c = 1 + (i - 1) Mod Telephone No: w(j, c) = a(i, 1)
If c = Telephone No Then j = j + 1
Next i
[c1].Resize(j, Telephone No) = w
End Sub
RE: Transpose Macro
Hi Krishan
The code is a bit opaque with variables like "w", "a" and "c" that makes it difficult to follow. I'd recommend you rename them something logical to help readability.
You will need some kind of conditional loop in there, such as
Do Until w(j, c) = "Telephone number"
...(code)...
Loop
Kind regards
Gary Fenn
Microsoft Office Specialist Trainer
Tel: 0207 987 3777
Best STL - https://www.stl-training.co.uk
98%+ recommend us
London's leader with UK wide delivery in Microsoft Office training and management training to global brands, FTSE 100, SME's and the public sector
RE: Transpose Macro
Thank you Gary
I am still having some issues around this
Would it be possible to send you an email with an attachment so its clearer? Alternatively could you call me?
We will be hiring STL's services in March at our company however I cannot wait until then to get this resolved.
My email address: singhkrishan@hotmail.com
Thanks again Gary
RE: Transpose Macro
Hi Krishan
Thanks for your email. I've rewritten the code to make it clearer and replied to your email as well. Here's the code below.
Sub Transpose2()
Dim i As Long
Dim LastRow As Long
Dim CurrentRow As Long
Dim CurrentColumn As Long
'Where's the last row? This is like going to cell A500000 and pressing CTRL + up
LastRow = Range("a500000").End(xlUp).Row
'Clean data first. The export process is much easier when the data is consistent
'What we're doing is bringing the records together. So when there's spaces
'between the blocks of data, delete cells to bring them together
'
'Loop through all the data until you hit that last row
For i = 0 To LastRow
'If you're at "View website" then you need to delete empty cells until there's no more
If Range("a1").Offset(i, 0) = "View website" Then
Do Until Range("a1").Offset(i + 1, 0) <> "" Or i > LastRow
Range("a1").Offset(i + 1, 0).Delete
LastRow = LastRow - 1
Loop
End If
Next i
'Now export
CurrentRow = 0
For i = 0 To LastRow
CurrentColumn = 0
'Export the data one row at a time
Do
CurrentColumn = CurrentColumn + 1
Range("c1").Offset(CurrentRow, CurrentColumn) = Range("a1").Offset(i, 0)
i = i + 1
'Until you find a cell containing "View website", then move to the next row
Loop Until Range("a1").Offset(i, 0) = "View website"
CurrentRow = CurrentRow + 1
Next i
End Sub
Kind regards
Gary Fenn
Microsoft Office Specialist Trainer
Tel: 0207 987 3777
Best STL - https://www.stl-training.co.uk
98%+ recommend us
London's leader with UK wide delivery in Microsoft Office training and management training to global brands, FTSE 100, SME's and the public sector
Training information:
Welcome. Please choose your application (eg. Excel) and then post your question. Our Microsoft Qualified trainers will then respond within 24 hours (working days). Frequently Asked Questions
Any suggestions, questions or comments? Please post in the Improve the forum thread. |
Excel tip:Validating text entries1. Select the range of cells.
where A1 is the first cell in the range. 6. Click OK. |