One way:

Public Sub hrs_FillUnitNmbr()
Dim nValue As Long
Dim i As Long

With Application
.ScreenUpdating = False
.Calculation = xlCalculationManual
End With
nValue = 0
With ThisWorkbook.Worksheets("Data")
For i = .Range("A" & .Rows.Count).End(xlUp).Row To 2 Step -1
With .Cells(i, 1)
If .Value nValue Then
nValue = CLng(.Value)
Else
.Value = nValue
End If
End With
Next i
End With
With Application
.ScreenUpdating = True
.Calculation = xlCalculationAutomatic
End With
End Sub


In article . com,
goss wrote:

Hi all -

I need to loop through a range from the bottom up
The cells in the range contain either a zero or a 5 digit number
If the value in the cell is greater than myValue, then assign the
value in the cell to myValue
Else, overwrite the value in the cell with myValue

It appears my macro has 2 errors
1.) It does not appear as though it is working backwards through the
cells, the address is always $A$271

2.)It is assigning the address as the value rather that the value of
the contents of the cell

Can you suggest how I may improve the macro?
Thanks
Best regards,
-markc

code:
Option Explicit

Sub hrs_FillUnitNmbr()

Dim wbBook As Workbook
Dim wsData As Worksheet
Dim myValue As Long
Dim myRange As Range
Dim lngRows As Long

'Setup Environment
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.Calculation = xlCalculationManual

Set wbBook = ThisWorkbook

With wbBook
Set wsData = .Worksheets("Data")
End With

lngRows = wsData.Range("A65536").End(xlUp).Row

With wsData
Set myRange = .Range("A" & lngRows)
End With

'Initialize
myValue = 0

'Fill
myValue = myRange.Value
Do While lngRows 1
Debug.Print myRange.Address
myRange = myRange.Address(lngRows, 1)
If myRange.Value myValue Then
myValue = myRange.Value
Else
myRange.Value = myValue
End If
lngRows = lngRows - 1
Loop

'Set Vaules - Clear Formulas
myRange.Copy
myRange.PasteSpecial xlPasteValues


'Calculate
Worksheets(1).Calculate

'Reset / Cleanup
Set wbBook = Nothing
Set wsData = Nothing
Set myRange = Nothing

Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Application.DisplayAlerts = True

End Sub