ExcelBanter

ExcelBanter (https://www.excelbanter.com/)
-   Excel Discussion (Misc queries) (https://www.excelbanter.com/excel-discussion-misc-queries/)
-   -   Evaluate value of cell to determine fill upwards (https://www.excelbanter.com/excel-discussion-misc-queries/164901-evaluate-value-cell-determine-fill-upwards.html)

goss[_2_]

Evaluate value of cell to determine fill upwards
 
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


JE McGimpsey

Evaluate value of cell to determine fill upwards
 
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


goss[_2_]

Evaluate value of cell to determine fill upwards
 
On Nov 6, 8:47 am, JE McGimpsey wrote:
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- Hide quoted text -


- 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



All times are GMT +1. The time now is 06:27 AM.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
ExcelBanter.com