Macro to transpose two columns and add an extra column to a number of fields

MrPink1986

Active Member
Joined
May 1, 2012
Messages
250
Hi there,

I have 67 fields in column A and B beginning in A2 and B2 - I would like to take the first value in A2 and place it in D1 and then the value in B2 and place it in E1. I would like to then add a column with "Diff" in F1. This column should be formatted to display a percentage value and 6 decimal places.

I would then like to loop through the values in A and B and follow this sequence for all 67 fields.
Any ideas on how this may be achieved?
 

Some videos you may like

Excel Facts

How to fill five years of quarters?
Type 1Q-2023 in a cell. Grab the fill handle and drag down or right. After 4Q-2023, Excel will jump to 1Q-2024. Dash can be any character.

mumps

Well-known Member
Joined
Apr 11, 2012
Messages
9,552
Try:
Code:
Sub MrPink()
    Application.ScreenUpdating = False
    Range("A2").Resize(67, 2).Copy Range("D1")
    With Range("F1")
        .Value = "Diff"
        .Resize(67, 1).NumberFormat = "0.000000%"
    End With
    Application.ScreenUpdating = True
End Sub
 
Last edited:

MrPink1986

Active Member
Joined
May 1, 2012
Messages
250
Thanks for your reply on this. I now realize I was not clear on the requirement.
I would like to take the first value in A2 and place it in D1 and then the value in B2 and place it in E1 and put the header "Diff" in D1.
Then repeat the process by taking the value in A3 and place it in G1, the value in B3 and place it in H1 and put the header "Diff" in I1.

So I want to transpose the data in columns A and B put in a certain sequence.

Try:
Code:
Sub MrPink()
    Application.ScreenUpdating = False
    Range("A2").Resize(67, 2).Copy Range("D1")
    With Range("F1")
        .Value = "Diff"
        .Resize(67, 1).NumberFormat = "0.000000%"
    End With
    Application.ScreenUpdating = True
End Sub
 

mumps

Well-known Member
Joined
Apr 11, 2012
Messages
9,552
Try:
Code:
Sub MrPink()
    Application.ScreenUpdating = False
    Dim rng As Range, lCol As Long
    For Each rng In Range("A2:A68")
        lCol = ActiveSheet.UsedRange.Columns.Count + 1
        If lCol < 4 Then lCol = 4
        rng.Resize(1, 2).Copy Cells(1, lCol)
        Cells(1, lCol + 2) = "Diff"
        Cells(2, lCol + 2).NumberFormat = "0.000000%"
    Next rng
    Application.ScreenUpdating = True
End Sub
 

MrPink1986

Active Member
Joined
May 1, 2012
Messages
250
Perfecto - that worked a treat and i now have my data lined up as I need it - thanks alot.

Try:
Code:
Sub MrPink()
    Application.ScreenUpdating = False
    Dim rng As Range, lCol As Long
    For Each rng In Range("A2:A68")
        lCol = ActiveSheet.UsedRange.Columns.Count + 1
        If lCol < 4 Then lCol = 4
        rng.Resize(1, 2).Copy Cells(1, lCol)
        Cells(1, lCol + 2) = "Diff"
        Cells(2, lCol + 2).NumberFormat = "0.000000%"
    Next rng
    Application.ScreenUpdating = True
End Sub
 

Watch MrExcel Video

Forum statistics

Threads
1,108,955
Messages
5,525,882
Members
409,669
Latest member
JDCupps

This Week's Hot Topics

Top