Loop until last row and update cell values when row changes - excel

Question

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:
After:
Kind Regards

Answer 1

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

Answer 2

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

Answer 3

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