Groups | Search | Server Info | Keyboard shortcuts | Login | Register [http] [https] [nntp] [nntps]

Groups > microsoft.public.excel.programming > #109868 > unrolled thread

Help condensing 2 step process

Back to article view | Back to microsoft.public.excel.programming

Contents

  Help condensing 2 step process Living the Dream <noodnutt@gmail.com> - 2017-02-21 00:06 -0800
    Re: Help condensing 2 step process Claus Busch <claus_busch@t-online.de> - 2017-02-21 09:41 +0100
      Re: Help condensing 2 step process GS <gs@v.invalid> - 2017-02-21 18:05 -0500
        Re: Help condensing 2 step process Living the Dream <noodnutt@gmail.com> - 2017-03-28 05:03 -0700
        Re: Help condensing 2 step process Living the Dream <noodnutt@gmail.com> - 2017-03-29 02:31 -0700
          Re: Help condensing 2 step process GS <gs@v.invalid> - 2017-03-29 11:57 -0400
      Re: Help condensing 2 step process Living the Dream <noodnutt@gmail.com> - 2017-03-28 05:02 -0700

#109868 — 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

[toc] | [next] | [standalone]

#109869

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

[toc] | [prev] | [next] | [standalone]

#109870

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

[toc] | [prev] | [next] | [standalone]

#109951

Hi GS

My apologies for late thank you.

Look promising. I will have a play with it soon thank you.

[toc] | [prev] | [next] | [standalone]

#109954

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.

[toc] | [prev] | [next] | [standalone]

#109960

> 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

[toc] | [prev] | [next] | [standalone]

#109950

Hi Claus

Apologies for late reply of thanks.

[toc] | [prev] | [standalone]

Back to top | Article view | microsoft.public.excel.programming

csiph-web