Please help me correct some minor issues with a macro :)

zacuk

Board Regular
Joined
Dec 22, 2016
Messages
60
Hi,

Someone has kindly written a macro for me which calculates the longest time interval (the time, in hours, is recorded in column C) corresponding to the variable data in column V. The macro finds the time window (in column C) that corresponds to the CONSECUTIVE Max data values in column V. We have set the MAX level range to the "Max value in column V to Max-0.5".

So, for example, for the following data (which exists on 'Sheet1' in my Excel file):

ColC ColV
01.27
0.01.42
2.02.90
4.03.00
6.03.20
8.01.74

<tbody>
</tbody>

The macro generates the following output in cell D101 of 'Summary' sheet:

Level considered Max..... 2.5 to 3
Number of times the Level Hit... 1
Longest of Which Lasted for.... 2 h
Corresponding Time Window... 2 to 4 h

Obviously, the macro has failed to recognize values higher than 3, which are CONSECUTIVE and are within MAX plus 0.5! The CORRECT report should look like this:

Level considered Max..... 2.7 to 3.2
Number of times the Level Hit... 1
Longest of Which Lasted for.... 4 h
Corresponding Time Window... 2 to 6 h

I guess, the problem may be arising due to the macro 'rounding off' the numbers??

I can work with complex Excel formulas, but I am not a macro writer yet :( So, I can't figure out how to fix it. I hope someone will be able to correct the macro for me, please. Thanks a lot.


Here is the macro:
Code:
Sub MaxABEduration()
Sheets("Sheet1").Select
Dim Rng As Range, Dn As Range, nRng As Range, oMax As Long, R As Range
Dim MyMax As Long, CDif As Integer
Dim col As Integer
col = 3
 If col = 0 Then Exit Sub
    CDif = col - 22
      Set Rng = Range("V5").Resize(50) '50 being the number of rows I want to look at
         MyMax = Application.Max(Rng)
Sheets("summary").Select
For Each Dn In Rng
    If Dn.Value >= MyMax - 0.5 And Dn.Value <= MyMax Then
        If nRng Is Nothing Then Set nRng = Dn Else Set nRng = Union(nRng, Dn)
    End If
Next Dn
For Each Dn In nRng.Offset(, CDif).Areas
    If Dn(Dn.Count) - Dn(1) > oMax Then
        oMax = Dn(Dn.Count) - Dn(1)
        Set R = Dn
    End If
Next Dn
ReDim Ray(1 To 4, 1 To 2)
Ray(1, 1) = "Level Considered Max": Ray(1, 2) = MyMax - 0.5 & " to " & MyMax & " g/L"
Ray(2, 1) = "Number of Times The Level Hit": Ray(2, 2) = nRng.Areas.Count
Ray(3, 1) = "Longest of Which Lasted for": Ray(3, 2) = R(R.Count) - R(1) & " h"
Ray(4, 1) = "Corresponding Time Window": Ray(4, 2) = R(1) & " to " & R(R.Count) & " h"
With Range("d101").Resize(4, 2) 'Change Location from D101 to suit
    .Value = Ray
    .NumberFormat = "@"
    .Columns.AutoFit
    .Borders.Weight = 2
End With
End Sub
 
Last edited by a moderator:
Spot it. Had forgot to update the 0Max and myMax declaration to 'double'. Fixed that bit.

Now, it is working as I want except that when there is a single data (in column V) which falls within the (Max to Max-0.5) range, it returns 'MyMax' value (i.e, MyMax g/L) in the following line, instead of 0 h (or a time in h)

Ray(3, 1) = "Longest of Which Lasted for": Ray(3, 2) = Def1 & " h"


The updated macro is:

Sub Maxduration()
Sheets("sheet1").Select
Dim Rng As Range, Dn As Range, nRng As Range, oMax As Double, R As Range
Dim MyMax As Double, CDif As Integer
Dim col As Integer
col = 3
If col = 0 Then Exit Sub
CDif = col - 22
Set Rng = Range("V5").Resize(50) 'Rws being the number of rows you want to look at !!
MyMax = Application.Max(Rng)
Sheets("summary").Select
For Each Dn In Rng
If Dn.Value >= MyMax - 0.5 And Dn.Value <= MyMax Then
If nRng Is Nothing Then Set nRng = Dn Else Set nRng = Union(nRng, Dn)
End If
Next Dn
For Each Dn In nRng.Offset(, CDif).Areas
If Dn(Dn.Count) - Dn(1) > oMax Then
oMax = Dn(Dn.Count) - Dn(1)
Set R = Dn
End If
Next Dn
ReDim Ray(1 To 4, 1 To 2)
Dim Def1 As Double, Def2 As String, Dex As Long
With Application
Dex = .Index(Rng.Offset(, CDif), .Match(MyMax, Rng, 0))
End With
If R Is Nothing Then
Def1 = MyMax
Def2 = Dex 'or:- '"Found ""0"""
Else
Def1 = R(R.Count) - R(1)
Def2 = R(1) & " to " & R(R.Count)
End If
Ray(1, 1) = "ABE Level Considered Max": Ray(1, 2) = MyMax - 0.5 & " to " & MyMax & " g/L"
Ray(2, 1) = "Number of Times The Level Hit": Ray(2, 2) = nRng.Areas.Count
Ray(3, 1) = "Longest of Which Lasted for": Ray(3, 2) = Def1 & " h"
Ray(4, 1) = "Corresponding Time Window": Ray(4, 2) = Def2 & " h"
With Range("d101").Resize(4, 2) 'Change Location from D101 to suit
.Value = Ray
.NumberFormat = "@"
.Columns.AutoFit
.Borders.Weight = 2
End With
End Sub
 
Upvote 0

Excel Facts

Bring active cell back into view
Start at A1 and select to A9999 while writing a formula, you can't see A1 anymore. Press Ctrl+Backspace to bring active cell into view.
Hi,

How can I make the macro return 0 h when there is only a single data point corresponding to the maximum level in column V, please.

i.e, the following should return 0 h in such cases:

Ray(3, 1) = "Longest of Which Lasted for": Ray(3, 2) = Def1 & " h"

I think it may be the case of changing MyMax for Def1 to something else (in the lines below), but I can't figure out what to write instead of MyMax here.

If R Is Nothing Then
Def1 = MyMax
Def2 = Dex 'or:- '"Found ""0"""

Thanks
 
Upvote 0
Hi Mick,

The following data, for example, would show5 h for Ray(3, 1) = "Longest of Which Lasted for": Ray(3, 2) = Def1 & " h", instead of 0 h.
0.001.42
2.002.90
4.005.00
6.003.20
8.001.74

<colgroup><col><col></colgroup><tbody>
</tbody>

Thanks
 
Upvote 0
Perhaps this:-
Code:
If r Is Nothing Then
 Def1 = [B][COLOR=#FF0000]IIf(nRng.Count = 1, 0, MyMax)[/COLOR][/B]
 Def2 = Dex 'or:- '"Found ""0"""
 Else
 
Upvote 0
For anyone who might be interested in it, please find below the final version of the macro. I have made a few minor changes, but thanks to Mick for creating the macro from scratch. The request for the macro was originally posted at: https://www.mrexcel.com/forum/excel...ultiple-times-during-process.html#post4713279

Thanks.


Sub MaxDuration() 'Change MaxDuration to another macro name that suits you
Sheets("sheet1").Select 'Change sheet1 to another sheet name where the source data is located at
Dim Rng As Range, Dn As Range, nRng As Range, oMax As Double, R As Range
Dim MyMax As Double, CDif As Integer
Dim col As Integer
col = 1 '1 is the column number in which the time is recorded (Col A being 1)
If col = 0 Then Exit Sub
CDif = col - 2 '2 is the column number in which the data is recorded (Col A being 1, hence col B'd be 2)
Set Rng = Range("B2").Resize(10) 'The data will be looked at from cell B2 to next 10 rows
MyMax = Application.Max(Rng)
Sheets("sheet1").Select 'Change sheet1 to another worksheet if you want the output on a different worksheet. This line can be deleted if you are going to work on the same sheet where the data is located at
For Each Dn In Rng
If Dn.Value >= MyMax - 0.5 And Dn.Value <= MyMax Then 'If you are looking for data range bigger or smaller than 0.5 difference, change 0.5 accordingly
If nRng Is Nothing Then Set nRng = Dn Else Set nRng = Union(nRng, Dn)
End If
Next Dn
For Each Dn In nRng.Offset(, CDif).Areas
If Dn(Dn.Count) - Dn(1) > oMax Then
oMax = Dn(Dn.Count) - Dn(1)
Set R = Dn
End If
Next Dn
ReDim Ray(1 To 4, 1 To 2)
Dim Def1 As Double, Def2 As String, Dex As Long
With Application
Dex = .Index(Rng.Offset(, CDif), .Match(MyMax, Rng, 0))
End With
If R Is Nothing Then
Def1 = IIf(nRng.Count = 1, 0, MyMax)
Def2 = Dex 'or:- '"Found ""0"""
Else
Def1 = R(R.Count) - R(1)
Def2 = R(1) & " to " & R(R.Count)
End If
Ray(1, 1) = "Level Considered Max": Ray(1, 2) = Format(MyMax - 0.5, "0.00") & " to " & Format(MyMax, "0.00") & " g/L" 'To change the decimal places in the output, increase or decrease the decimal digits in "0.00"
Ray(2, 1) = "Number of Times The Level Hit": Ray(2, 2) = nRng.Areas.Count
Ray(3, 1) = "Longest of Which Lasted for": Ray(3, 2) = Def1 & " h"
Ray(4, 1) = "Corresponding Time Window": Ray(4, 2) = Def2 & " h"
With Range("d5").Resize(4, 2) 'Change the output location from d5 to suit your need
.Value = Ray
.NumberFormat = "@"
.Columns.AutoFit
.Borders.Weight = 2
End With
End Sub
 
Upvote 0

Forum statistics

Threads
1,214,877
Messages
6,122,051
Members
449,064
Latest member
scottdog129

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top