Using single cell in loop as trigger to to copy multiple ranges VBA

user_18151569 0
Viewed 47

The macro is working with hard coded inputs but I need loops for debugging and future growth. I don't know the best way to set this up.

Range("b3:b8:) are the cells I would like to loop over.

If cell.value = 1 then
Set var1 = range("a3:aq3") (* This range always has the same row number as cell in loop*)

Set var2 = range("a9:aq9") (*This range always 6 greater than row of cell in loop.)

End if

Next cell Thanks

vba excel loops
2 Answers

Loop Through Rows of a Range

Option Explicit

Sub LoopThroughRows()
    
    Const srgAddress As String = "A3:AQ8"
    Const scCol As Long = 2
    Const sCriteria As String = "1"
    
    Dim sws As Worksheet: Set sws = ActiveSheet ' improve, e.g.:
    'Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
    'Dim sws As Worksheet: Set sws = wb.Worksheets("Sheet1")
    
    Dim srg As Range: Set srg = sws.Range(srgAddress) ' last use of 'sws'
    Dim srCount As Long: srCount = srg.Rows.Count
    
    Dim srg1 As Range
    Dim srg2 As Range
    Dim sCell As Range
    Dim sr As Long
    
    For Each sCell In srg.Columns(scCol).Cells ' don't forget '.Cells'!
        sr = sr + 1 ' monitoring each range row (not worksheet row)
        If CStr(sCell.Value) = sCriteria Then ' also avoiding error values
            Set srg1 = srg.Rows(sr)
            Set srg2 = srg1.Offset(srCount)
            ' Continue... e.g.:
            Debug.Print sr, sCell.Address(0, 0), _
                srg1.Address(0, 0), srg2.Address(0, 0)
        Else ' not equal to sCriteria (usually do nothing)
            ' e.g.:
            Debug.Print sr, sCell.Address(0, 0), "Nope."
        End If
    Next sCell
    
End Sub
user_98140690

Have you tried using a for loop?

Eg:

For Each Cell in Range("B3:B8")
  If Cell.Value = 1 Then
    Set var1 = range("a3:aq3")
  Else
    Set var2 = range("a9:aq9")
  End If
Next Cell
user_161967760
Related