Thread: [SOLVED] Culling consecutive numbers into ranges
View Single Post
  #9  
Old 06-24-2009, 02:19 AM
DonkeyOte's Avatar
DonkeyOte DonkeyOte is offline
Forum Guru
  
Join Date: 22 Oct 2008
Location: Suffolk, UK
MS Office Version:2002 & 2007
Posts: 13,664
DonkeyOte has a reputation beyond repute DonkeyOte has a reputation beyond repute DonkeyOte has a reputation beyond repute DonkeyOte has a reputation beyond repute DonkeyOte has a reputation beyond repute DonkeyOte has a reputation beyond repute DonkeyOte has a reputation beyond repute DonkeyOte has a reputation beyond repute DonkeyOte has a reputation beyond repute DonkeyOte has a reputation beyond repute DonkeyOte has a reputation beyond repute
Re: Culling consecutive numbers into ranges
Kris' code didn't work for me based on the sample 20 as it needs (I think) a slight tweak re: last range.

Anyway - below is revision of my original using Currency as opposed to Long as outlined previously and a couple of other tweaks as it didn't work correctly anyway.

Code:
Public Sub BlockVals()
Dim rngData As Range
Dim curMin As Currency, curMax As Currency
Dim lngCount As Long, lngI As Long
Set rngData = Range(Cells(1, "A"), Cells(Rows.Count, "A").End(xlUp))
lngCount = Evaluate("1+SUMPRODUCT(--(" & rngData.Offset(1).Address & ">" & rngData.Address & "+1))")
For lngI = 1 To lngCount
    curMin = Evaluate("MIN(IF(" & rngData.Address & ">" & curMax & "," & rngData.Address & "))")
    curMax = Evaluate("MIN(IF((" & rngData.Offset(1).Address & ">(" & rngData.Address & "+1))*(" & rngData.Address & ">=" & curMin & ")," & rngData.Address & "))")
    curMax = IIf(lngI = lngCount, Application.Max(rngData), curMax)
    Cells(lngI, "B") = curMin & IIf(curMax, "-" & curMax, "")
Next lngI
Set rngData = Nothing
End Sub
Reply With Quote