A Microsoft Excel forum. ExcelBanter

If this is your first visit, be sure to check out the FAQ by clicking the link above. You may have to register before you can post: click the register link above to proceed. To start viewing messages, select the forum that you want to visit from the selection below.

Go Back   Home » ExcelBanter forum » Excel Newsgroups » Excel Programming
Site Map Home Register Authors List Search Today's Posts Mark Forums Read Web Partners

Help condensing 2 step process



 
 
Thread Tools Display Modes
  #1  
Old February 21st 17, 08:06 AM posted to microsoft.public.excel.programming
Living the Dream
external usenet poster
 
Posts: 119
Default 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
Ads
  #2  
Old February 21st 17, 08:41 AM posted to microsoft.public.excel.programming
Claus Busch
external usenet poster
 
Posts: 3,451
Default 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  
Old February 21st 17, 11:05 PM posted to microsoft.public.excel.programming
GS[_6_]
external usenet poster
 
Posts: 714
Default 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  
Old March 28th 17, 01:02 PM posted to microsoft.public.excel.programming
Living the Dream
external usenet poster
 
Posts: 119
Default Help condensing 2 step process

Hi Claus

Apologies for late reply of thanks.
  #5  
Old March 28th 17, 01:03 PM posted to microsoft.public.excel.programming
Living the Dream
external usenet poster
 
Posts: 119
Default 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  
Old March 29th 17, 10:31 AM posted to microsoft.public.excel.programming
Living the Dream
external usenet poster
 
Posts: 119
Default 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  
Old March 29th 17, 04:57 PM posted to microsoft.public.excel.programming
GS[_6_]
external usenet poster
 
Posts: 714
Default 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
 




Thread Tools
Display Modes

Posting Rules
You may not post new threads
You may not post replies
You may not post attachments
You may not edit your posts

vB code is On
Smilies are On
[IMG] code is On
HTML code is Off
Forum Jump

Similar Threads
Thread Thread Starter Forum Replies Last Post
Creating a Drop Down List with Step by Step Instructions for 2007 remarkable Excel Worksheet Functions 2 March 22nd 09 04:36 AM
Need step by step to add invoice numbering to excel template rmt New Users to Excel 4 July 6th 08 11:45 PM
What is the step-by-step procedure for making a data list? Bobgolfs56 Excel Discussion (Misc queries) 1 April 23rd 05 02:19 PM
I need step by step instructions to create a macro for 10 imbedde. diana Excel Worksheet Functions 3 January 31st 05 01:56 AM
step into process Tom Ogilvy Excel Programming 0 August 16th 03 12:46 PM


All times are GMT +1. The time now is 12:22 AM.


Powered by vBulletin® Version 3.6.4
Copyright ©2000 - 2017, Jelsoft Enterprises Ltd.
Copyright 2004-2017 ExcelBanter.
The comments are property of their posters.