Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

Register Log in
  • Congratulations biv343 on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Excel: How to find a maximum value with VBA? 3

Status
Not open for further replies.
xitu

xitu

Technical User
Oct 1, 2003
55
US
This is my sample block. "HP" marks value > 11300. How do I find maximum value in HP range and mark the word "MAX" next to it. How do I loop through the whole worksheet?

ColA ColB ColC
================================
10966.327
11176.779
11267.391
11305.390 HP
11404.770 HP
11477.844 HP
11485.638 HP MAX
11442.769 HP
11451.537 HP
11444.717 HP
11443.742 HP
11437.896 HP
11446.665 HP
11441.794 HP
9301.220
8962.157
8653.299
8335.671
8030.710
7735.492
7376.943
================================

Sub findMax()
While ActiveCell.Offset(0, -2).Value > 0 'activecell is col C
If ActiveCell.Offset(0, -1).Value = "HP" Then
'find maximum value
'I don't know the syntax here:
'If ActiveCell.Offset(0, -1) Is max Then ActiveCell.Offset(-1, 1).Value = "MAX"

End If
ActiveCell.Offset(1, 0).Select
Wend
End Sub

 
Sort by date Sort by votes
Hi,

Code: 
    nMAX = Application.Max(Range("A:A"))
    r = Application.Match(nMAX, Range("A:A"), 0)
    If Not IsError(r) Then Cells(r, 3).Value = "MAX"
:)

Skip,
Skip@TheOfficeExperts.com
 
Upvote 0 Downvote
Skip, very neat! But assumes that there is no "MAX" from a prior run (which is probably a good assumption.)

xitu: If you find Skip's solution hard to follow, here is a lengthier example of how this could be done (which may or may not be easier to understand, but should be easier to maintain. Also, you asked how to loop thru the whole worksheet, so this provides a sample). Note that I also included code to set/reset the "HP" flag, which you can remove if you want to:
[blue]
Code: 
Option Explicit

Sub MarkMax()
Const HIGH_PRESSURE = 11300
Dim c As Range
Dim nMaxValue As Double
Dim nMaxAddress As String

  Application.ScreenUpdating = False
  nMaxValue = 0
  For Each c In Intersect(ActiveSheet.UsedRange, Range("A:A"))
    If c.Value > HIGH_PRESSURE Then
[green]
Code: 
      ' Set "HP"
[/color]
Code: 
      c.Offset(0, 1) = "HP"
      If c > nMaxValue Then
        nMaxValue = c
        nMaxAddress = c.Offset(0, 2).Address
      End If
    Else
[green]
Code: 
      ' Clear "HP"
[/color]
Code: 
      c.Offset(0, 1) = ""
    End If
[green]
Code: 
    ' Clear "MAX"
[/color]
Code: 
    c.Offset(0, 2) = ""
  Next c
[green]
Code: 
  ' Set "MAX"
[/color]
Code: 
  Range(nMaxAddress) = "MAX"
  Application.ScreenUpdating = True
End Sub
[code][/color][/b]
 
Upvote 0 Downvote
SkipVought, Zathras

Thanks for your help.

I tried both methods but did not get the result I wished. It only returned one "MAX" for the largest value in column. I would like to find "MAX" for each HP blocks (i.e. I will see some "MAX" in some "HP blocks)

10966.327
11176.779
11267.391
11305.390 HP
11404.770 HP
11477.844 HP
11485.638 HP "MAX"
11442.769 HP
11451.537 HP
11444.717 HP
11443.742 HP
11437.896 HP
11446.665 HP
11441.794 HP
9301.220
8962.157
8653.299
8335.671
8030.710
7735.492
7376.943
8653.299
8335.671
8030.710
7735.492
7376.943
6874.196
6155.150
11387.232 HP
11390.258 HP "MAX"
11388.206 HP
11386.258 HP
11386.258 HP
11385.283 HP
11385.283 HP
11384.310 HP
11384.310 HP
11385.283 HP
11384.310 HP
11384.310 HP
8335.671
8030.710
7735.492
7376.943
8335.671
8030.710
7735.492
7376.943


 
Upvote 0 Downvote
No problem:
[blue]
Code: 
Option Explicit

Sub MarkMax()
Const HIGH_PRESSURE = 11300
Dim c As Range
Dim nMaxValue As Double
Dim nMaxAddress As String

  Application.ScreenUpdating = False
  nMaxValue = 0
  For Each c In Intersect(ActiveSheet.UsedRange, Range("A:A"))
    If c.Value > HIGH_PRESSURE Then
[green]
Code: 
      ' Set "HP"
[/color]
Code: 
      c.Offset(0, 1) = "HP"
      If c > nMaxValue Then
        nMaxValue = c
        nMaxAddress = c.Offset(0, 2).Address
      End If
    Else
[green]
Code: 
      ' Clear "HP" and update "MAX"
[/color]
Code: 
      c.Offset(0, 1) = ""
      On Error Resume Next
      Range(nMaxAddress) = """MAX"""
      nMaxValue = 0
    End If
[green]
Code: 
    ' Clear "MAX"
[/color]
Code: 
    c.Offset(0, 2) = ""
  Next c
[green]
Code: 
  ' Set "MAX"
[/color]
Code: 
  Application.ScreenUpdating = True
End Sub
[/color]
 
Upvote 0 Downvote
Sorry, need one more line of code at the end to cater to the possibility that the last entry is type "HP" in order to post the "MAX":
[blue]
Code: 
Option Explicit

Sub MarkMax()
Const HIGH_PRESSURE = 11300
Dim c As Range
Dim nMaxValue As Double
Dim nMaxAddress As String

  Application.ScreenUpdating = False
  nMaxValue = 0
  For Each c In Intersect(ActiveSheet.UsedRange, Range("A:A"))
    If c.Value > HIGH_PRESSURE Then
[green]
Code: 
      ' Set "HP"
[/color]
Code: 
      c.Offset(0, 1) = "HP"
      If c > nMaxValue Then
        nMaxValue = c
        nMaxAddress = c.Offset(0, 2).Address
      End If
    Else
[green]
Code: 
      ' Clear "HP" and update "MAX"
[/color]
Code: 
      c.Offset(0, 1) = ""
      On Error Resume Next
      Range(nMaxAddress) = """MAX"""
      nMaxValue = 0
    End If
[green]
Code: 
    ' Clear "MAX"
[/color]
Code: 
    c.Offset(0, 2) = ""
  Next c
[green]
Code: 
  ' Set "MAX"
[/color]
Code: 
  Range(nMaxAddress) = """MAX"""
  Application.ScreenUpdating = True
End Sub
[/color]
 
Upvote 0 Downvote
It works wonderful, Zathras. Thanks

Now I am working on the code to mark the HP end point (END) where the difference between two pressures is greater than 10. Then set the clock from MAX starts with 0:00:00 and increments by 3 to HP end point (END). Do you have any ideal?

=======================================
10966.327
11176.779
11267.391
11305.390 HP
11404.770 HP
11477.844 HP
11485.638 HP "MAX" 0:00:00
11442.769 HP 0:00:03
11451.537 HP 0:00:06
11444.717 HP 0:00:09
11443.742 HP 0:00:12
11437.896 HP 0:00:15
11446.665 HP 0:00:18
11441.794 HP "END" 0:00:21
9301.220
8962.157
8653.299
8335.671
8030.710
7735.492
7376.943
8653.299
8335.671
8030.710
7735.492
7376.943
6874.196
6155.150
11387.232 HP
11390.258 HP "MAX" 0:00:00
11388.206 HP 0:00:03
11386.258 HP 0:00:06
11386.258 HP 0:00:09
11385.283 HP 0:00:12
11385.283 HP 0:00:15
11384.310 HP 0:00:18
11384.310 HP 0:00:21
11385.283 HP 0:00:24
11384.310 HP 0:00:27
11384.310 HP "END" 0:00:30
8335.671
8030.710
7735.492
7376.943
8335.671
8030.710
7735.492
7376.943
=======================================

 
Upvote 0 Downvote
I would have thought the "END" should go on the first line after the "HP" entries (otherwise, the last time read-out seems to me to be short by 3 seconds. But here is a modified routine to do what you are asking.
[blue]
Code: 
Option Explicit
Const PRESSURE_DATA_COLUMN = "A:A"
Const HIGH_PRESSURE = 11300
Const HP_SYMBOL = "HP"
Const MAX_SYMBOL = """MAX"""
Const END_SYMBOL = """END"""
Const TICK_INTERVAL = 3
[green]
Code: 
 '(seconds)
[/color]
Code: 
Const SECONDS_PER_DAY = 86400

Sub MarkMax()
Dim c As Range
Dim nMaxValue As Double
Dim nMaxAddress As String

  Application.ScreenUpdating = False
  nMaxValue = 0
  For Each c In Intersect(ActiveSheet.UsedRange, Range(PRESSURE_DATA_COLUMN))
    If c.Value > HIGH_PRESSURE Then
[green]
Code: 
      ' Mark "HP"
[/color]
Code: 
      c.Offset(0, 1) = HP_SYMBOL
      If c > nMaxValue Then
        nMaxValue = c
        nMaxAddress = c.Offset(0, 2).Address
      End If
    Else
[green]
Code: 
      ' Clear "HP" and set "MAX" (with time ticks)
[/color]
Code: 
      c.Offset(0, 1) = ""
      MaxTimeTicks nMaxAddress
      nMaxValue = 0
    End If
[green]
Code: 
    ' Clear "MAX"
[/color]
Code: 
    c.Offset(0, 2) = ""
  Next c
[green]
Code: 
  ' Set "MAX" (with time ticks)
[/color]
Code: 
  MaxTimeTicks nMaxAddress
  Application.ScreenUpdating = True
End Sub

Private Sub MaxTimeTicks(StartAddress As String)
Dim rng As Range
Dim nSeconds As Integer
Dim nTime As Double

  If StartAddress <> &quot;&quot; Then
    Set rng = Range(StartAddress)
    rng.Value = MAX_SYMBOL
    While rng.Offset(0, -1) = HP_SYMBOL
      nTime = nSeconds / SECONDS_PER_DAY
      rng.Offset(0, 1) = WorksheetFunction.Text(nTime, &quot;h:mm:ss&quot;)
      Set rng = rng.Offset(1, 0)
      nSeconds = nSeconds + TICK_INTERVAL
    Wend
    If rng.Offset(-1, 0) <> MAX_SYMBOL Then
       rng.Offset(-1, 0) = END_SYMBOL
    Else
       rng.Offset(-1, 0) = MAX_SYMBOL & &quot; (&quot; & END_SYMBOL & &quot;)&quot;
    End If
    Set rng = Nothing
  End If
End Sub
[/color]
BTW, this is what I meant when i wrote &quot;easier to maintain&quot; -- change is a way of life for programs.
 
Upvote 0 Downvote
Yes, Zathras. I agree that your code is very neat and easy to maintain. I like the way you comment your code. It makes more sense to a technical user like me. Thanks alot.

I am trying to modify your code to have two additional functions (one is calculate the differential pressure and another one is plot chart where x-axis is the &quot;TimeTicks&quot; and y is the differential pressure)

Please take a look at
I really need your help since I don't know much VBA syntax. I am still learning.

Thanks again
 
Upvote 0 Downvote
xitu,

I see that you are a new member. Welcome aboard! Hopefully, you will get lots of helpful & expert help if you ask for it, and you, yourself, may use your expertise to help other members.

When someone like Zathras has provided helpful/expert assistance, as indeed he has, it is expected that the recipent, that's YOU, and maybe other observers as well,
Mark this post as a helpful/expert post!
This is where the STARS come from. It not only lets Zathras know that you appreciated his expertise, but it also FLAGS ths post so that others might benefit as well.

So be sure to
Mark this post as a helpful/expert post!
:)

Skip,
Skip@TheOfficeExperts.com
 
Upvote 0 Downvote
Thanks for the info SkipVought.
 
Upvote 0 Downvote
I tried to hardcode to get the diff. P by adding
'calculate diff_P
rng.Offset(-1, 2) = &quot;=R6C1-RC[-4]&quot;
under
.
.
.
Set rng = rng.Offset(1, 0)
nSeconds = nSeconds + TICK_INTERVAL

and got the result for the first block. How do I calculate the diff_P in other blocks?

Thanks,
 
Upvote 0 Downvote
Hi,

If Zathras doesn't post back, and I'm sure he will, in the mean time, check this out. I have not gone to all the trouble that Zathras has, but it shows an example of applying the pressure differential, sightly different approch...
Code: 
Sub HP()
    Const SEC_PER_DAY = 86400
    r1 = 1
    r2 = 0
    Do While r1 <= ActiveSheet.Cells(1, 1).CurrentRegion.Rows.Count
        If Cells(r1, 2).Value = &quot;&quot; Then
            r1 = Cells(r1, 2).End(xlDown).Row
            If r1 = Cells.Rows.Count Then Exit Do
            r2 = r1
            If Cells(r1, 2).Offset(1, 0).Value = &quot;HP&quot; Then
                r2 = Cells(r1, 2).End(xlDown).Row
            End If
            Set rng = Range(Cells(r1, 1), Cells(r2, 1))
            nMAX = Application.Max(rng)
            r = Application.Match(nMAX, rng, 0)
            If Not IsError(r) Then
                Cells(r + r1 - 1, 3).Value = &quot;&quot;&quot;MAX&quot;&quot;&quot;
                Cells(r2, 3).Value = &quot;&quot;&quot;END&quot;&quot;&quot;
                t = 0
                Set rng = Range(Cells(r + r1 - 1, 4), Cells(r2, 4))
         'Base Pressure
                pBase = Cells(r + r1 - 2, 1).Value
                For Each c In rng
                    With c
                        .Value = t
                        .NumberFormat = &quot;[h]:mm:ss&quot;
         'insert Pressure differential
                        .Offset(0, 1).Value = pBase - Cells(.Row, 1).Value
                    End With
                    t = t + 3 / SEC_PER_DAY
                Next
            End If
            r1 = r2 + 1
        End If
    Loop
End Sub
:)

Skip,
Skip@TheOfficeExperts.com
 
Upvote 0 Downvote
Skip,

I think something wrong with the condition and the code is terminated at

If r1 = Cells.Rows.Count Then Exit Do

If I run Zathras's code then yours, it works for the calculation part (calculate diff. P)

Do you know how to make the chart (series) based on this diff. P column and the &quot;time&quot; column by using VBA?

Thanks for your help,

 
Upvote 0 Downvote
xitu

That's where it ends, when the row pointer, r1, equals the number of rows on the spreadsheet, 655536.

There is no need to code the series...

using Insert/Names/Define...
define TimeTics as
Code: 
=OFFSET(Sheet3!$D$1,0,0,COUNTA(Sheet3!$A:$A),1)
define PressDiff as
Code: 
=OFFSET(Sheet3!$E$1,0,0,COUNTA(Sheet3!$A:$A),1)
Then in the chart/source data series tab, substitute the CELL RANGE REFERENCE (ie leave the Sheet3! part there) with TimeTics in the x-axis and PressDiff in the y-axis.

This will make your chart dymanic without code! :)

Skip,
Skip@TheOfficeExperts.com
 
Upvote 0 Downvote
Skip,

It works but how do I have different colours for series?

Thanks again,
 
Upvote 0 Downvote
Skip,

Could you take a look at Zathras's latest code and help me to calculate the differential pressure, please?

I think Zathras is busy now... I tried to calculate the diff. pressure but no luck :(

Thanks,
xitu
 
Upvote 0 Downvote
Just replace this subroutine. The other one is OK.
Code: 
Private Sub MaxTimeTicks(StartAddress As String)
Dim rng As Range
Dim nSeconds As Integer
Dim nTime As Double
Dim pBase As Double

  If StartAddress <> &quot;&quot; Then
    Set rng = Range(StartAddress)
'New Line
    pBase = rng.Offset(-1, -2).Value
    rng.Value = MAX_SYMBOL
    While rng.Offset(0, -1) = HP_SYMBOL
      nTime = nSeconds / SECONDS_PER_DAY
      rng.Offset(0, 1) = WorksheetFunction.Text(nTime, &quot;h:mm:ss&quot;)
'New Line
      rng.Offset(0, 2) = pBase - rng.Offset(0, -2).Value
      Set rng = rng.Offset(1, 0)
      nSeconds = nSeconds + TICK_INTERVAL
    Wend
    If rng.Offset(-1, 0) <> MAX_SYMBOL Then
       rng.Offset(-1, 0) = END_SYMBOL
    Else
       rng.Offset(-1, 0) = MAX_SYMBOL & &quot; (&quot; & END_SYMBOL & &quot;)&quot;
    End If
    Set rng = Nothing
  End If
End Sub


Skip,
Skip@TheOfficeExperts.com
 
Upvote 0 Downvote
Status
Not open for further replies.

Similar threads

remeng
  • Locked
  • Question
Run PowerShell Commands from Excel VBA
Replies
14
Views
3K
dhookom
dhookom
Andrzejek
  • Locked
  • Question
Outlook VBA - Trust access
Replies
3
Views
871
hermanlaksko
hermanlaksko
thanhthanh12
  • Locked
  • Question
Help vba
Replies
3
Views
551
combo
combo
K
  • Locked
  • Question
How to resolve define worksheets array
Replies
1
Views
648
combo
combo
remeng
  • Locked
  • Question
Excel VBA to Pass Var between file macros after var changes
Replies
13
Views
659
mikrom
mikrom

Part and Inventory Search

Sponsor

Back
Top