Evaluate value of cell to determine fill upwards

G

goss

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
 
J

JE McGimpsey

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
 
G

goss

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




















- Show quoted text -

Thanks a lot JE -
One small logic problem
As we are going up Col A the value will change from either 0 or some 5
digit number
We always need to pickup the new 5 digit number. We don't know if it
is greater or less than the preceeding 5 digit number
All we know is it is greater than zero

The small change I made to the code picks up the change and popultes
the cells upward until another change is found, then picks up the new
value and continues on

Thanks very much for the great help
Best regards,
-markc

Option Explicit

Sub hrs_FillUnitNmbr()

Dim nValue As Long
Dim i As Long

Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.Calculation = xlCalculationManual

nValue = 0

'Fill
With ThisWorkbook.Worksheets("Data")
For i = .Range("A" & .Rows.Count).End(xlUp).Row To 2 Step
-1
With .Cells(i, 1)
If .Value > 0 Then
nValue = .Value
Else
.Value = nValue
End If
End With
Next i
End With

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

End Sub
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads


Top