Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Help condensing 2 step process
Hi All
I managed to do this in a 2 part code, but was hoping to condense it into 1. Here is my original 2 step process: The following stored the equated/evaluated value in a cell ( which I am trying to avoid ). Sub Get_Weight() Dim tSht As Worksheet Dim tRng As Range, c As Range Set tSht = Sheets("TMS DATA") Set tRng = tSht.Range("O6:O350") For Each c In tRng If Not c.Offset(, -14) = "" Then With c .Offset(, 37).Value = (c.Value / c.Offset(, -1).Value) End With End If Next c End Sub Then I ran the following to highlight those rows(Column Ranged) that met the criteria, which work quite well. Sub Check_Weight() Dim tSht As Worksheet Dim vRng As Range, c As Range Dim wgt As Double Set tSht = Sheets("TMS DATA") Set vRng = tSht.Range("AZ6:AZ350") wgt = 1136 For Each c In vRng If Not c.Offset(, -49) = "" Then If c wgt Then With c .Offset(, -50).Resize(, 31).Interior.ColorIndex = 0 End With End If End If Next c End Sub I tried the following but to no success: Sub Check_Weight() Dim tSht As Worksheet Dim vRng As Range, c As Range Dim wgt As Double Set tSht = Sheets("TMS DATA") Set vRng = tSht.Range("O6:O350") wgt = 1136 For Each c In vRng If Not c.Offset(, -13) = "" Then If (c.Value / c.Offset(, -1).Value) wgt Then With c .Offset(, -14).Resize(, 31).Interior.ColorIndex = 0 End With End If End If Next c End Sub As always any thoughts, comments or suggestions are welcomed and appreciated. TIA |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
Help condensing 2 step process
Hi,
Am Tue, 21 Feb 2017 00:06:39 -0800 (PST) schrieb Living the Dream: I managed to do this in a 2 part code, but was hoping to condense it into 1. Here is my original 2 step process: The following stored the equated/evaluated value in a cell ( which I am trying to avoid ). Sub Get_Weight() End Sub Then I ran the following to highlight those rows(Column Ranged) that met the criteria, which work quite well. Sub Check_Weight() End Sub try: Sub Check_Weight() Dim tSht As Worksheet Dim tRng As Range, c As Range Const wgt = 1136 Set tSht = Sheets("TMS DATA") Set tRng = tSht.Range("O6:O350") For Each c In tRng If c.Offset(, -14) < 0 Then With c .Offset(, 37).Value = (c.Value / c.Offset(, -1).Value) If .Offset(, 37) wgt Then _ .Offset(, -14).Resize(1, 31).Interior.ColorIndex = 0 End With End If Next c End Sub Regards Claus B. -- Windows10 Office 2016 |
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
Help condensing 2 step process
FWIW:
Each time VB encounters an 'IF' statement it fires a new evaluation process. In this scenario, things would process more efficiently (and faster) if coded to eliminate unecessary 'IF' statements... Sub Check_Weight2() ' This directly reads/writes the worksheet (faster) Dim rng, c Const lWt& = 1136 For Each c In Sheets("TMS DATA").Range("O6:O350") Set rng = c.Offset(, 37) With Cells(c.Row, 1) On Error Resume Next '//ignore divide by zero rng.Value = (c.Value / c.Offset(, -1).Value) If rng.Value lWt Then .Resize(1, 31).Interior.ColorIndex = 0 End With Next 'rng Set rng = Nothing End Sub Sub CheckWeight3() ' This handles the process in memory (much faster); ' It assumes all columns being processed are inside UsedRange. Dim vRng, n&, lCol&, lCol2& Const lWt& = 1136: Const lStart& = 6: Const lStop& = 350 With Sheets("TMS DATA") vRng = .UsedRange: lCol = .Columns("O").Column lCol2 = lCol + 37 '(15+37=52) ~ Columns("AZ") For n = lStart To lStop On Error Resume Next '//ignore divide by zero vRng(n, lCol2) = vRng(n, lCol) / vRng(n, lCol - 1) Next 'n On Error GoTo 0 'Shade cells that fit criteria .UsedRange = vRng For n = lStart To lStop If vRng(n, lCol2) lWt Then _ .Cells(n, 1).Resize(1, 31).Interior.ColorIndex = 0 Next 'n End With 'Sheets("TMS DATA") End Sub -- Garry Free usenet access at http://www.eternal-september.org Classic VB Users Regroup! comp.lang.basic.visual.misc microsoft.public.vb.general.discussion |
#4
Posted to microsoft.public.excel.programming
|
|||
|
|||
Help condensing 2 step process
Hi Claus
Apologies for late reply of thanks. |
#5
Posted to microsoft.public.excel.programming
|
|||
|
|||
Help condensing 2 step process
Hi GS
My apologies for late thank you. Look promising. I will have a play with it soon thank you. |
#6
Posted to microsoft.public.excel.programming
|
|||
|
|||
Help condensing 2 step process
Hi Garry
Thank you again for your idea's. I ended up using your 1st example as the 2nd triggers an Error 9, Subscript Out of Range. 'Shade cells that fit criteria .UsedRange = vRng For n = lStart To lStop HERE--- If vRng(n, lCol2) lWt Then _ .Cells(n, 1).Resize(1, 31).Interior.ColorIndex = 0 Next 'n End With 'Sheets("TMS DATA") End Sub The other works super quick. |
#7
Posted to microsoft.public.excel.programming
|
|||
|
|||
Help condensing 2 step process
HERE--- If vRng(n, lCol2) lWt Then _
.Cells(n, 1).Resize(1, 31).Interior.ColorIndex = 0 The above is 1 line broken into 2 for posting only. Perhaps Excel is losing track of its ref to the sheet so always safe to use fully qualified ref... If vRng(n, lCol2) lWt Then _ Sheets("TMS DATA").Cells(n, 1).Resize(1, 31).Interior.ColorIndex = 0 -- Garry Free usenet access at http://www.eternal-september.org Classic VB Users Regroup! comp.lang.basic.visual.misc microsoft.public.vb.general.discussion |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Creating a Drop Down List with Step by Step Instructions for 2007 | Excel Worksheet Functions | |||
Need step by step to add invoice numbering to excel template | New Users to Excel | |||
What is the step-by-step procedure for making a data list? | Excel Discussion (Misc queries) | |||
I need step by step instructions to create a macro for 10 imbedde. | Excel Worksheet Functions | |||
step into process | Excel Programming |