transpose macro

Public Schedule Face-to-Face & Online Instructor-Led Training - View dates & book

Forum home » Delegate support and help forum » Microsoft Excel VBA Training and help » Transpose Macro

Transpose Macro

resolvedResolved · Urgent Priority · Version 2007

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

RE: Transpose Macro

Thanks Gary.

Nice Job!

Appreciate it

 

Training courses

 

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
What does 'Resolved' mean?

Any suggestions, questions or comments? Please post in the Improve the forum thread.


 

Excel tip:

Validating text entries

1. Select the range of cells.
2. From the Data menu, select Validation.
3. Select the Settings tab.
4. From the Allow dropdown list, select Custom.
5. In the Formula box, enter the following formula:

=IsText (A1)

where A1 is the first cell in the range.
6. Click OK.

View all Excel hints and tips


Server loaded in 0.08 secs.