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

0	1.27
0.0	1.42
2.0	2.90
4.0	3.00
6.0	3.20
8.0	1.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:

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

 

[MickG]

Change Declaration for "oMax" and "MyMax" to Double, as below

Dim Rng As Range, Dn As Range, nRng As Range,[B][COLOR=#FF0000] oMax As Double[/COLOR][/B], R As Range
 Dim [B][COLOR=#FF0000]MyMax As Double[/COLOR][/B], CDif As Integer

 

[zacuk]

That's great. It works perfect. Thanks a lot Mick.

Running the macro, some times return an error message (Run Time Error 91: Object Variable or With Block Variable Not Set). NOTE: I think, this error is generated when only one cell contains maximum! (maybe the macro cannot work out the range, in this case).

Any thought on this, please. Thanks

 

[zacuk]

PS:

Also, can we ask the macro to return the 'Max Level' up to 1 decimal place only, please? So, e.g., return 2.3 to 2.8 g/L instead of 2.25654 to 2.768443 g/L, in the following command:

Ray(1, 1) = "Level Considered Max": Ray(1, 2) = MyMax - 0.5 & " to " & MyMax & " g/L"

Thanks.

 

[MickG]

The code will error if it can't find a range of data in column "V" that is a group that matches the criteria.
The following will stop it, but you may want something else to happen, depends what you want to get from your data.??

[B][COLOR=#b22222]If oMax > 0 Then[/COLOR][/B]
    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("p1").Resize(4, 2) 'Change Location from D101 to suit
            .Value = Ray
            .NumberFormat = "@"
            .Columns.AutoFit
            .Borders.Weight = 2
        End With
[B][COLOR=#ff0000]End If
[/COLOR][/B]

Added format

    Ray(1, 1) = "Level Considered Max": Ray(1, 2) = [COLOR=#FF0000]Format(MyMax - 0.5, "0.00") & " to " & Format(MyMax, "0.00") & " g/L"
[/COLOR]

 

[zacuk]

Great help Mick.

The format command works perfect. The other one also does in the sense that now it won't generate the error, as you said.

Maybe we can create another logic/rule that, if there is only a single data value within the (Max to Max-0.5), return it as the output.

Can we use something like:

if count(Max to Max-0.5)=1, then return that single (Max) value, otherwise "the rest of the macro, as is" ....... (Note: this is just the logic; not actual macro commands )

Thanks

 

[zacuk]

PS:

Using Excel's Record Macro function, I managed the following formula to work with my macro, as it'd return the max value if it occurs only once. However, I am not sure how to seamlessly incorporate it into the above macro (I had to delete a couple of rows from the macro to Debug it to function). Any help will be appreciated. Thanks


ActiveCell.FormulaR1C1 = _
"=IF(COUNTIF(R[-37]C[1]:R[13]C[1],"">""&MAX(R[-37]C[1]:R[13]C[1])-0.5)=1,MAX(R[-37]C[1]:R[13]C[1]),"""")"

 

[MickG]

Perhaps this mod:-

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) = "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("d1").Resize(4, 2) 'Change Location from D101 to suit
    .Value = Ray
    .NumberFormat = "@"
    .Columns.AutoFit
    .Borders.Weight = 2
End With

 

[zacuk]

Awesome!

Seems perfect for now. Great help Mick.

Thanks a lot.

 

[zacuk]

Hi Mick,

It's giving error at the following step. (NOTE: If I remove this line from the macro, then the error message doesn't appear, but the macro doesn't returns anything): (Thanks)


Dex = .Index(Rng.Offset(, CDif), .Match(MyMax, Rng, 0))


Here is the complete macro, just in case you can spot some mistake in the way I have updated it, please:

Sub Maxduration()
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) '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) = "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("d1").Resize(4, 2) 'Change Location from D101 to suit
.Value = Ray
.NumberFormat = "@"
.Columns.AutoFit
.Borders.Weight = 2
End With
End Sub