Home 
Search 
Today's Posts 
#1




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




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




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.eternalseptember.org Classic VB Users Regroup! comp.lang.basic.visual.misc microsoft.public.vb.general.discussion 
#4




Help condensing 2 step process
Hi Claus
Apologies for late reply of thanks. 
#5




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




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




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.eternalseptember.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 stepbystep 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 