Using same macro across all rows of a Range

Question

I wrote a macro that gets two variables from a row (PartQty & PartLenght) and it uses that to do a series of iterative calculations, and in the end, it prints the results in a set of cells in the same row. (FornoSPouRJ is the only variable that is fixed.)

I want to use the same macro in all of the rows in the range I select, and print the final values.

My code below. (variables are in my native language for the most part)

Sub CálculoTamanhoBarra()

Dim PartQty As Double
Dim PartLenght As Double
Dim ExcessPartQty As Double
Dim PecaBarraInteira As Double
Dim BarrasInteiras As Double
Dim QtdePecasUmaBarraInteira As Double
Dim MetragemBarraInteira As Double
Dim PecasUltimaBarra As Double
Dim MetragemBarraIncompleta As Double
Dim RawStkQty As Double
Dim RawStkLenght As Double
Dim FornoSPouRJ As Double
Dim Pecastotal As Double

'******This is where I want to put a range******

PartQty = Range("D2").Value
FornoSPouRJ = Worksheets("Parâmetros").Range("C5").Value
PartLenght = Range("H2").Value
ExcessPartQty = 0

QtdePecasUmaBarraInteira = Application.WorksheetFunction.RoundDown((FornoSPouRJ / (PartLenght + 10)), 0)
BarrasInteiras = Application.WorksheetFunction.RoundDown((PartQty / QtdePecasUmaBarraInteira), 0)
PecaBarraInteira = BarrasInteiras * QtdePecasUmaBarraInteira
MetragemBarraInteira = QtdePecasUmaBarraInteira * (PartLenght + 10)
PecasUltimaBarra = PartQty - (BarrasInteiras * QtdePecasUmaBarraInteira)
MetragemBarraIncompleta = PecasUltimaBarra * (PartLenght + 10)
Pecastotal = PecasUltimaBarra + PecaBarraInteira

'******This is where I want to put the same range as before******

Range("S2").Value = PecaBarraInteira
Range("T2").Value = BarrasInteiras
Range("U2").Value = QtdePecasUmaBarraInteira
Range("V2").Value = MetragemBarraInteira
Range("W2").Value = PecasUltimaBarra
Range("X2").Value = MetragemBarraIncompleta
Range("Y2").Value = Pecastotal

MetragemBarraInteira2 = 999

If (MetragemBarraIncompleta = 0) Then GoTo Jump

'Inicio Processo Iterativo

Do

    If (PecasUltimaBarra + BarrasInteiras < QtdePecasUmaBarraInteira - 1) Then
        If (MetragemBarraIncompleta + (BarrasInteiras * (PartLenght + 10))) > FornoSPouRJ Then
            ExcessPartQty = (MetragemBarraInteira - MetragemBarraIncompleta) / (PartLenght + 10)
        Else
            ExcessPartQty = 0
        End If
    Else
         ExcessPartQty = (MetragemBarraInteira - MetragemBarraIncompleta) / (PartLenght + 10)
    End If

    If (ExcessPartQty = 0) Then
        PecaBarraInteira = PecaBarraInteira - BarrasInteiras
    Else
        PecaBarraInteira = PecaBarraInteira
    End If

    If (ExcessPartQty > 0) Then
        BarrasInteiras = BarrasInteiras + 1
    Else
        BarrasInteiras = BarrasInteiras
    End If

    If (ExcessPartQty = 0) Then
        QtdePecasUmaBarraInteira = QtdePecasUmaBarraInteira - 1
    Else
        QtdePecasUmaBarraInteira = QtdePecasUmaBarraInteira
    End If

    If (ExcessPartQty = 0) Then
        MetragemBarraInteira = MetragemBarraInteira - (PartLenght + 10)
    Else
        MetragemBarraInteira = MetragemBarraInteira
    End If

    If (ExcessPartQty = 0) Then
        PecasUltimaBarra = PecasUltimaBarra + BarrasInteiras
    Else
        PecasUltimaBarra = PecasUltimaBarra + ExcessPartQty
    End If

    MetragemBarraIncompleta = PecasUltimaBarra * (PartLenght + 10)

Loop Until MetragemBarraIncompleta = MetragemBarraInteira

Pecastotal = PecasUltimaBarra + PecaBarraInteira

'******This is where I want to put the same range as before******

Range("R2").Value = ExcessPartQty
Range("S2").Value = PecaBarraInteira
Range("T2").Value = BarrasInteiras
Range("U2").Value = QtdePecasUmaBarraInteira
Range("V2").Value = MetragemBarraInteira
Range("W2").Value = PecasUltimaBarra
Range("X2").Value = MetragemBarraIncompleta
Range("Y2").Value = Pecastotal

Jump:

End Sub

Answer 1

Make your procedure dynamic so it can take a variable iRow for the row number you want to process. Then use a second procedure to loop through your rows and run your original procedure on every of these rows.

Option Explicit

Public Sub Example()
    Dim iRow As Long
    For iRow = 2 To 5  ' loop trough rows 2 to 5 and do the same stuff in every row
        DoYoursStuff iRow
    Next iRow
End Sub

Public Sub DoYoursStuff(ByVal iRow As Long)
    Dim PartQty As Double
    Dim PartLenght As Double
    Dim ExcessPartQty As Double
    Dim PecaBarraInteira As Double
    Dim BarrasInteiras As Double
    Dim QtdePecasUmaBarraInteira As Double
    Dim MetragemBarraInteira As Double
    Dim PecasUltimaBarra As Double
    Dim MetragemBarraIncompleta As Double
    Dim RawStkQty As Double
    Dim RawStkLenght As Double
    Dim FornoSPouRJ As Double
    Dim Pecastotal As Double
    
    '******This is what I want to put a Range******
    PartQty = Range("D" & iRow).Value
    FornoSPouRJ = Worksheets("Parâmetros").Range("C5").Value
    PartLenght = Range("H" & iRow).Value
    ExcessPartQty = 0
    
    QtdePecasUmaBarraInteira = Application.WorksheetFunction.RoundDown((FornoSPouRJ / (PartLenght + 10)), 0)
    BarrasInteiras = Application.WorksheetFunction.RoundDown((PartQty / QtdePecasUmaBarraInteira), 0)
    PecaBarraInteira = BarrasInteiras * QtdePecasUmaBarraInteira
    MetragemBarraInteira = QtdePecasUmaBarraInteira * (PartLenght + 10)
    PecasUltimaBarra = PartQty - (BarrasInteiras * QtdePecasUmaBarraInteira)
    MetragemBarraIncompleta = PecasUltimaBarra * (PartLenght + 10)
    Pecastotal = PecasUltimaBarra + PecaBarraInteira

    
    '******This is what I want to put the same range as before******     
    Range("S" & iRow).Value = PecaBarraInteira
    Range("T" & iRow).Value = BarrasInteiras
    Range("U" & iRow).Value = QtdePecasUmaBarraInteira
    Range("V" & iRow).Value = MetragemBarraInteira
    Range("W" & iRow).Value = PecasUltimaBarra
    Range("X" & iRow).Value = MetragemBarraIncompleta
    Range("Y" & iRow).Value = Pecastotal
    
    MetragemBarraInteira2 = 999
    
    If Not MetragemBarraIncompleta = 0 Then
    
        'Inicio Processo Iterativo
        
        Do
            If PecasUltimaBarra + BarrasInteiras < QtdePecasUmaBarraInteira - 1 Then
                If MetragemBarraIncompleta + (BarrasInteiras * (PartLenght + 10)) > FornoSPouRJ Then
                    ExcessPartQty = (MetragemBarraInteira - MetragemBarraIncompleta) / (PartLenght + 10)
                Else
                    ExcessPartQty = 0
                End If
            Else
                ExcessPartQty = (MetragemBarraInteira - MetragemBarraIncompleta) / (PartLenght + 10)
            End If

            If ExcessPartQty > 0 Then
                BarrasInteiras = BarrasInteiras + 1
            End If
        
            If ExcessPartQty = 0 Then
                PecaBarraInteira = PecaBarraInteira - BarrasInteiras
                QtdePecasUmaBarraInteira = QtdePecasUmaBarraInteira - 1
                MetragemBarraInteira = MetragemBarraInteira - (PartLenght + 10)
                PecasUltimaBarra = PecasUltimaBarra + BarrasInteiras
            Else
                PecasUltimaBarra = PecasUltimaBarra + ExcessPartQty
            End If
    
            MetragemBarraIncompleta = PecasUltimaBarra * (PartLenght + 10)
        Loop Until MetragemBarraIncompleta = MetragemBarraInteira
        
        Pecastotal = PecasUltimaBarra + PecaBarraInteira

        '******This is what I want to put the same range as before******
        Range("R" & iRow).Value = ExcessPartQty
        Range("S" & iRow).Value = PecaBarraInteira
        Range("T" & iRow).Value = BarrasInteiras
        Range("U" & iRow).Value = QtdePecasUmaBarraInteira
        Range("V" & iRow).Value = MetragemBarraInteira
        Range("W" & iRow).Value = PecasUltimaBarra
        Range("X" & iRow).Value = MetragemBarraIncompleta
        Range("Y" & iRow).Value = Pecastotal
    End If
End Sub

Note that using GoTo is a very bad practice. Instead use a normal If Not … Then to skip code.

I also reduced your multiple If ExcessPartQty = 0 Then to the necessary part only and removed the unnecessary parenthesis.

Another recommendation is not to leave any Range or Cells object without referencing a sheet like you did in Worksheets("Parâmetros").Range("C5").Value because otherwise VBA will use the default and you might not like that.