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

[zacuk]

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
[TABLE="width: 135"]
<tbody>[TR]
[TD]0[/TD]
[TD]1.27[/TD]
[/TR]
[TR]
[TD]0.0[/TD]
[TD]1.42[/TD]
[/TR]
[TR]
[TD]2.0[/TD]
[TD]2.90[/TD]
[/TR]
[TR]
[TD]4.0[/TD]
[TD]3.00[/TD]
[/TR]
[TR]
[TD]6.0[/TD]
[TD]3.20[/TD]
[/TR]
[TR]
[TD]8.0[/TD]
[TD]1.74[/TD]
[/TR]
</tbody>[/TABLE]

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:

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

 

[zacuk]

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

 

[zacuk]

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

 

[MickG]

Please show small sample of column "C" & V" when the Ray(3,2) should return :- 0 h.

 

[zacuk]

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.
[TABLE="width: 174"]
<colgroup><col><col></colgroup><tbody>[TR]
[TD="align: right"][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]0.00[/TD]
[TD]1.42[/TD]
[/TR]
[TR]
[TD]2.00[/TD]
[TD]2.90[/TD]
[/TR]
[TR]
[TD]4.00[/TD]
[TD]5.00[/TD]
[/TR]
[TR]
[TD]6.00[/TD]
[TD]3.20[/TD]
[/TR]
[TR]
[TD]8.00[/TD]
[TD]1.74[/TD]
[/TR]
</tbody>[/TABLE]

Thanks

 

[MickG]

Perhaps this:-

If r Is Nothing Then
 Def1 = [B][COLOR=#FF0000]IIf(nRng.Count = 1, 0, MyMax)[/COLOR][/B]
 Def2 = Dex 'or:- '"Found ""0"""
 Else

 

[zacuk]

Hi Mick, Yes it worked. Thanks a lot.

 

[zacuk]

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