CODEWITHSUNDEEP
excelvbaloops
Ginzo
Ginzo

Reputation: 3

Looping part of a code till variable is reached

Can someone help me out? I need to loop the following code that should stop once a cell in the D column of the 'Calendario' sheet is empty. Cell count should start at D8, not before.

Variables are the following: First 'copy' changes of 1 row each time and the 'paste' have to be +52 rows each time Second 'copy' is static and and the 'paste' have to be +52 rows each time Third 'copy' changes of 1 row each time and the 'paste' have to be +52 rows each time

What I've done below works, and I could repeat it 200 times but it's not clean nor healthy to do so lol

First time playing with VBA and I'm learning as it goes.

Many thanks to anyone who can help!

'Row 1

Sheets("Calendario").Range("E8:G8").Copy Destination:=Sheets("Export").Range("A2:C53")
Application.CutCopyMode = False

Worksheets("Calendario").Range("O7:BN7").Copy
Worksheets("Export").Range("D2").PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True

Worksheets("Calendario").Range("O8:BN8").Copy
Worksheets("Export").Range("F2").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True

'Row 2

Sheets("Calendario").Range("E9:G9").Copy Destination:=Sheets("Export").Range("A54:C105")
Application.CutCopyMode = False

Worksheets("Calendario").Range("O7:BN7").Copy
Worksheets("Export").Range("D54").PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True

Worksheets("Calendario").Range("O9:BN9").Copy
Worksheets("Export").Range("F54").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True

Upvotes: 0

Views: 56

Answers (1)

eirikdaude
eirikdaude

Reputation: 3254

I think this should give you a good start for what you want to do:

Sub LoopingForDummies()
    Dim r As Range
    Dim i As Long

    ' The with-statement says that while we are inside the block, we are working on that object, saving us from having to type in that part of the address
    With ThisWorkbook.Sheets("Calendario")
        ' Set the range we are gonna loop over, the latter part of the range statements says that we go to the last cell in column D in which there is no data
        Set r = .Range(.Range("D8"), .Range("D" & .Rows.Count).End(xlUp))

        ' Loop over each cell in the range
        For i = 1 To r.Count
            ' Exit out of the sub if the cell is blank
            ' r.Cells(1, 1) = D8, r.Cells(2, 1) = D9, etc
            If IsEmpty(r.Cells(i, 1)) Then
                Exit Sub
            ' If not execute the code for that row
            ' D8 offset by 0,1 = E8, D8 offset by 0,3 = G8, etc
            ' A2 offset by 52,0 = A54
            Else
                .Range(r.Cells(i, 1).Offset(0, 1), r.Cells(i, 1).Offset(0, 3)).Copy _
                                    Destination:=Sheets("Export").Range("A2:C53").Offset(52 * (i - 1), 0)
            End If
        Next i
    End With
End Sub

I tried to explain what is going on in the comments, but if you feel something is unclear, feel free to post a comment on my answer.

I can't guarantee that this code does everything you want - if for instance you have code executed after what you are showing in your question, you probably want a different method for breaking out of the loop than what I am showing above.

Upvotes: 1

Related Questions