Reply
 
LinkBack Thread Tools Search this Thread Display Modes
  #1   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 151
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
  #2   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 3,872
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   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 1,182
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   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 151
Default Help condensing 2 step process

Hi Claus

Apologies for late reply of thanks.
  #5   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 151
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   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 151
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   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 1,182
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
Reply
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes

Posting Rules

Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On


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 05: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 02: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 09:42 PM.

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

About Us

"It's about Microsoft Excel"