Find earliest and latest date in ranges with blanks

[kathyb0527]

As part of a larger vba project, I need to find the earliest date in a range and subtract from the latest date in another range to get the length of time (number of days). In addition, the range with the earliest date has blanks. Everything I've tried so far ends up with a 0. I know dates are tricky, but for the life of me I can't figure it out. I've tried min and max and mina and maxa, to no avail. I'd appreciate any pushes in the right direction.

thank you,

[mancubus]

try this.



Sub MaxMinDateDiff()


Dim minD As Long, maxD As Long, diffD As Long
Dim Rng As Range

Set Rng = Range("A1:C5000") 'Change to suit

minD = Evaluate("=MIN(IF(" & Rng.Address & ">0," & Rng.Address & "))")
maxD = Application.Max(Rng)
diffD = maxD - minD

MsgBox diffD


End Sub

[kathyb0527]

Thank you for the reply, however, I still get a 0 for the min and max values. I cannot post the entire file as it has confidential information, so I have copied the two columns I am trying to get the information from. I'm also including the relevant portion of the code I'm attempting so the ranges won't match the excel file but I think you'll get the gist. Thanks again for the help.



'Calculate LTS
Set rLocation = Range("Z2:Z" & Range("A" & Rows.Count).End(xlUp).Row)
For Each c In rLocation
c.Value = "=round(RC[-6]-RC[-8],0)"
c.NumberFormat = "0"
If IsError(c) = True Then
c.Value = "0"
End If
c.Offset(0, -1).Value = "=RC[-4]-RC[-5]"
c.Offset(0, -1).NumberFormat = "[h]:mm"
Next c
Select Case Application.CountIf(rLocation, 0)
Case Is = rLocation.Cells.Count: strLTS = "not calculated"
Case 0: strLTS = Application.Max(rLocation)
Case Is < rLocation.Cells.Count: minD = Evaluate("=MIN(IF(" & Range("R2:R" & Range("A" & Rows.Count).End(xlUp).Row).Address & ">0," & Range("R2:R" & Range("A" & Rows.Count).End(xlUp).Row).Address & "))")
maxD = Application.Max(Range("T2:T" & Range("A" & Rows.Count).End(xlUp).Row))
strLTS = maxD - minD
End Select

[mancubus]

welcome. i think columns R, T, and U contain dates and blank cells. try this.

Sub ddiff_vba()
Dim LR As Long, minD As Long, maxD As Long, strLTS As Long
Dim rLocation As Range
LR = Range("A" & Rows.Count).End(xlUp).Row
Set rLocation = Range("Z2:Z" & LR)
With rLocation
.FormulaR1C1 = "=IFERROR(ROUND(RC[-6]-RC[-8],0),0)"
.NumberFormat = "0"
.Offset(0, -1).FormulaR1C1 = "=RC[-4]-RC[-5]"
.Offset(0, -1).NumberFormat = "[h]:mm"
End With
Select Case Application.CountIf(rLocation, 0)
Case Is = rLocation.Cells.Count
strLTS = "not calculated"
Case 0
strLTS = Application.Max(rLocation)
Case Is < rLocation.Cells.Count
minD = Evaluate("=MIN(IF(" & Range("R2:R" & Range("A" & Rows.Count).End(xlUp).Row).Address & ">0," & Range("R2:R" & Range("A" & Rows.Count).End(xlUp).Row).Address & "))")
maxD = Application.Max(Range("T2:T" & Range("A" & Rows.Count).End(xlUp).Row))
strLTS = maxD - minD
End Select
MsgBox "MinDate: " & minD & " or " & Format(minD, "mm.dd.yyyy")
MsgBox "MaxDate: " & maxD & " or " & Format(maxD, "mm.dd.yyyy")
MsgBox "DaysDiff: " & strLTS
End Sub

[mancubus]

i cant upload a file in my office computer nor can i paste the codes here with line feeds. ---- also I (or VBAX) cant upload a file from dropbox or skydrive using mobile/smart phone.

[mancubus]

finallay attached a sample file :)



Sub ddiff_vba()
Dim LR As Long, minD As Long, maxD As Long, strLTS As Long
Dim rLocation As Range
LR = Range("A" & Rows.Count).End(xlUp).Row
Set rLocation = Range("Z2:Z" & LR)
With rLocation
.FormulaR1C1 = "=IFERROR(ROUND(RC[-6]-RC[-8],0),0)"
.NumberFormat = "0"
.Offset(0, -1).FormulaR1C1 = "=RC[-4]-RC[-5]"
.Offset(0, -1).NumberFormat = "[h]:mm"
End With
Select Case Application.CountIf(rLocation, 0)
Case Is = rLocation.Cells.Count
strLTS = "not calculated"
Case 0
strLTS = Application.Max(rLocation)
Case Is < rLocation.Cells.Count
minD = Evaluate("=MIN(IF(" & Range("R2:R" & Range("A" & Rows.Count).End(xlUp).Row).Address & ">0," & Range("R2:R" & Range("A" & Rows.Count).End(xlUp).Row).Address & "))")
maxD = Application.Max(Range("T2:T" & Range("A" & Rows.Count).End(xlUp).Row))
strLTS = maxD - minD
End Select
MsgBox "MinDate: " & minD & " or " & Format(minD, "mm.dd.yyyy")
MsgBox "MaxDate: " & maxD & " or " & Format(maxD, "mm.dd.yyyy")
MsgBox "DaysDiff: " & strLTS
End Sub

[kathyb0527]

When I use your example sheet, it works. However, when I plug in my dates, I still get "0".

[mancubus]

perhaps seeing your file may help diagnose the problems.

[kathyb0527]

Sorry, I thought I had attached an example with my last post, but I can't seem to be able to attach a file right now.

[snb]

Sub M_snb()
x = [max(if(T2:T100="",0,if(R2:R100="",0,T2:T100-R2:R100)))] & " days"
y = [min(if(T2:T100="",today(),if(R2:R100="",today(),abs(T2:T100-R2:R100))))] & " days"
End Sub

[Aussiebear]

Is the formatting of the cells the same?

[kathyb0527]

I finally could upload/attach a file. It is really just the dates because the rest is confidential, but it will give you an idea of the formatting of the cells. I really appreciate everyone's help on this.

[mancubus]

your table contains strings displayed as dates rather than dates. so you have to convert them to dates before running the macro.