How to loop a a macro in excel VBA

Question

I want to loop a certain macro in excel VBA. However, I don't know how to do this (I tried and failed multiple times). The annotations in the code below are given to show what I want to do. The code as it is works perfectly, I just want it to loop for every chunck of data until all data has been transposed into the second worksheet (the first worksheet contains about 5000 rows of data, and every 18 rows has to be transposed into 1 row in the second worksheet):

    Sub test()

' test Macro

Range("G2").Select
ActiveCell.FormulaR1C1 = "=RC[-2]/RC[-1]*100"
Range("G2").Select
Selection.AutoFill Destination:=Range("G2:G19"), Type:=xlFillDefault
Range("G2:G19").Select
Range("A2:C2").Select
Selection.Copy
Sheets("Sheet2_Transposed data").Select
Range("A2").Select
ActiveSheet.Paste
    'I want to loop this for every next row until all data has been pasted (so A3, A4, etc.)
Sheets("Sheet1_session_data").Select
Range("G2:G19").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Sheet2_Transposed_data").Select
Range("D2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=True
Range("D2:U2").Select
Application.CutCopyMode = False
    'Here I also want to loop for every next row until all data has been transposed and pasted (e.g. D3:U3, D4:U4 etc.)
Selection.NumberFormat = "0"
Sheets("Sheet1_session_data").Select
Rows("2:19").Select
Selection.Delete Shift:=xlUp
    ' Here I delete the entire data chunck that has been transposed, so the next chunck of data is the same selection. 

End Sub

Hope this question was understandable, and I hope someone can help. Thanks.

what do you mean you want to loop? there are other data in Sheet1_session_data? Cause in your code, you already deleted the entire Row("2:19"). or does that mean after you have looped through all the columns? Can you somehow show sample data, and expected result? We can help post screen shots, just provide the link. — L42
– L42, Commented Feb 10, 2014 at 8:31
Edited post, I need to tranpose 5000 (or more) rows of data, and every 18 rows is data from 1 user that has to be transposed into 1 row on the second worksheet. — Arco Jansen
– Arco Jansen, Commented Feb 10, 2014 at 8:35
Can you give me a sample data so that I can give you an exact code with explanation? — Siddharth Rout
– Siddharth Rout, Commented Feb 10, 2014 at 8:52

Community · Accepted Answer · 2017-05-23 11:56:59Z

5

You can actually reduce your code.

First Tip:

Please avoid the use of .Select/.Activate INTERESTING READ

Second Tip:

Instead of doing an Autofill, you can enter the formula in the relevant cells in one go. For example. this

Range("G2").Select
ActiveCell.FormulaR1C1 = "=RC[-2]/RC[-1]*100"
Range("G2").Select
Selection.AutoFill Destination:=Range("G2:G19"), Type:=xlFillDefault

can be written as

Range("G2:G19").FormulaR1C1 = "=RC[-2]/RC[-1]*100"

Third Tip:

You don't need to do a copy and paste in separate lines. You can do it in one line. For example

Range("A2:C2").Select
Selection.Copy
Sheets("Sheet2_Transposed data").Select
Range("A2").Select
ActiveSheet.Paste

can be written as

Range("A2:C2").Copy Sheets("Sheet2_Transposed data").Range("A2")

Same thing when you are doing a PasteSpecial. But you use .Value = .Value soo this

Range("G2:G19").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Sheet1_Transposed_data").Select
Range("D2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True

can be written as

Sheets("Sheet1_Transposed_data").Range("D2:D19").Value = _
Sheets("Sheet1").Range("G2:G19").Value

Missed the Transpose part. (Thanks Simoco). In this case, you can write the code as

Range("A2:C2").Copy 
Sheets("Sheet2_Transposed data").Range("D2").PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=True

Fourth Tip:

To loop through cells, you can use a For Loop. Say you want to loop though cells A2 to A20 then you can do like this

For i = 2 To 20
    With Range("A" & i)
        '
        '~~> Do Something
        '
    End With
Next i

EDIT:

Your before and after Screenshots (From Comments):

enter image description here

and

enter image description here

After seeing your screenshots, I guess this is what you are trying? This is untested as I just quickly wrote it. Let me know if you get any errors :)

Sub test()
    Dim wsInPut As Worksheet, wsOutput As Worksheet
    Dim lRow As Long, NewRw As Long, i As Long

    '~~> Set your sheets here
    Set wsInPut = ThisWorkbook.Sheets("Sheet1_session_data")
    Set wsOutput = ThisWorkbook.Sheets("Sheet2_Transposed data")

    '~~> Start row in "Sheet2_Transposed data"
    NewRw = 2

    With wsInPut
        '~~> Find Last Row
        lRow = .Range("A" & .Rows.Count).End(xlUp).Row

        '~~> Calculate the average in one go
        .Range("G2:G" & lRow).FormulaR1C1 = "=RC[-2]/RC[-1]*100"

        '~~> Loop through the rows
        For i = 2 To lRow Step 18
            wsOutput.Range("A" & NewRw).Value = .Range("A" & i).Value
            wsOutput.Range("B" & NewRw).Value = .Range("B" & i).Value
            wsOutput.Range("C" & NewRw).Value = .Range("C" & i).Value

            .Range("G" & i & ":G" & (i + 17)).Copy

            wsOutput.Range("D" & NewRw).PasteSpecial Paste:=xlPasteValues, _
            Operation:=xlNone, SkipBlanks:=False, Transpose:=True

            NewRw = NewRw + 1
        Next i

        wsOutput.Range("D2:U" & (NewRw - 1)).NumberFormat = "0"
    End With
End Sub

edited May 23, 2017 at 11:56

CommunityBot

11 silver badge

answered Feb 10, 2014 at 8:32

Siddharth Rout

150k18 gold badges212 silver badges258 bronze badges

Sign up to request clarification or add additional context in comments.

25 Comments

Arco Jansen Over a year ago

I understand my code can be shorter, thanks for that. But I do need to loop (see edit question)

Arco Jansen Over a year ago

That I also understand, thank you. But I don't want a set selection range. I want to be able to loop until all data from the first worksheet has been transposed into the second. (Because the amount of data will differ from time to time, sometimes 5000 rows of data, sometimes 15000 rows of data).

Siddharth Rout Over a year ago

@ArcoJansen: Have you seen THIS? simply replace 20 with LastRow

Siddharth Rout Over a year ago

@ArcoJansen: I still think, you may not need a loop. See the EDIT in my updated answer. Let me know if that is what you are trying to do?

Siddharth Rout Over a year ago

@simoco: Yeah I thought about that but then decided to wait for the sample data because I have a feeling that I will have to change that part after I see the data :)

|

Collectives™ on Stack Overflow

How to loop a a macro in excel VBA

1 Answer 1

25 Comments

Your Answer

Linked

Hot Network Questions

Collectives™ on Stack Overflow

1 Answer 1

25 Comments

Your Answer

Sign up or log in

Post as a guest

Linked

Related