Loop until last row and update cell values when row changes

user_14444210 0
Viewed 991

Hi I am trying to update cell values on all rows until the row number changes. Here is my code:

 Sub MyLoop()

 Dim i As Integer
 Dim var As String
 Dim LastRow As Long

 LastRow = Range("A" & Rows.Count).End(xlUp).Row

 i = 1

 var = Cells(i, 4).Value

 For i = 1 To LastRow

    If Range("A" & i).Value = "1" Then

       Cells(i, 2).Value = var
  
    End If

    var = Cells(i, 4).Value

 Next i

 End Sub

I have attached before and after images of how it should look once routine has been ran. Basically Loop through all rows and in column A is the number changes store the value in column D and paste it into column B until the row number changes.

Before:

enter image description here

After:

enter image description here

Kind Regards

while-loop for-loop vba excel loops
3 Answers

Is it really when the number changes or when the word in Column D changes?

Columns("D:D").Cut Destination:=Columns("B:B")
Range("B1:B" & Cells(Rows.Count, "A").End(xlUp).Row).SpecialCells(xlCellTypeBlanks).FormulaR1C1 = "=R[-1]C"
Range("B1:B" & Cells(Rows.Count, "A").End(xlUp).Row).Value = Range("B1:B" & Cells(Rows.Count, "A").End(xlUp).Row).Value
user_13922350 
Sub MyLoop()

 Dim i As Integer
 Dim var As String
 Dim LastRow As Long

 LastRow = Range("A" & Rows.Count).End(xlUp).Row

 For i = 1 To LastRow
    IF Cells(i, 4).Value<>"" Then 'Get new value from column 4
       var = Cells(i, 4).Value
    End If

    Cells(i, 2).Value = var       'Assign value to column 2

 Next i

 End Sub
user_7240390

Fill Column

A Quick Fix

Sub MyLoop()

    Dim LastRow As Long
    Dim i As Long
    Dim A As Variant
    Dim D As Variant
    
    LastRow = Cells(Rows.Count, 1).End(xlUp).Row
    
    For i = 1 To LastRow
        If Cells(i, 1).Value <> A Then
            A = Cells(i, 1).Value
            D = Cells(i, 4).Value
        End If
        Cells(i, 2).Value = D
    Next i

End Sub

A More Flexible Solution

  • Adjust the values in the constants section.
Option Explicit

Sub fillColumn()
    
    ' Define constants.
    Const wsName As String = "Sheet1"
    Const ColumnsAddress As String = "A:D"
    Const LookupCol As Long = 1
    Const CriteriaCol As Long = 4
    Const ResultCol As Long = 2
    Const FirstRow As Long = 2
    
    ' Define Source Range.
    Dim rng As Range
    With ThisWorkbook.Worksheets(wsName).Columns(ColumnsAddress)
        Set rng = .Columns(LookupCol).Resize(.Rows.Count - FirstRow + 1) _
            .Offset(FirstRow - 1).Find( _
                What:="*", _
                LookIn:=xlFormulas, _
                SearchDirection:=xlPrevious)
        If rng Is Nothing Then
            Exit Sub
        End If
        Set rng = .Resize(rng.Row - FirstRow + 1).Offset(FirstRow - 1)
    End With
    
    ' Write values from Source Range to Data Array.
    Dim Data As Variant: Data = rng.Value
    
    ' Define Result Array.
    Dim Result As Variant: ReDim Result(1 To UBound(Data, 1), 1 To 1)
    
    ' Declare additional variables.
    Dim cLookup As Variant ' Current Lookup Value
    Dim cCriteria As Variant ' Current Criteria Value
    Dim i As Long ' Rows Counter
    
    ' Write values from Data Array to Result Array.
    For i = 1 To UBound(Data, 1)
        If Data(i, LookupCol) <> cLookup Then
            cLookup = Data(i, LookupCol)
            cCriteria = Data(i, CriteriaCol)
        End If
        Result(i, 1) = cCriteria
    Next i
    
    ' Write from Result Array to Destination Column Range.
    rng.Columns(ResultCol).Value = Result

End Sub
user_98140690
Related