View Single Post
  #2  
Old 06-23-2009, 06:26 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,574
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

Quite a few ways to do this, looping etc... not sure how much data you have and/or where you want your resulting values to appear... below is based on replacing original values in A with ranged numbers...

Code:
Public Sub BlockVals()
Dim rngData As Range
Dim lngMin As Long, lngMax As Long, lngCount As Long, lngI As Long
Dim vResults As Variant
Set rngData = Range(Cells(1, "A"), Cells(Rows.Count, "A").End(xlUp))
lngCount = Evaluate("1+SUMPRODUCT(--(" & rngData.Offset(1).Address & ">" & rngData.Address & "+1))")
ReDim vResults(1 To lngCount, 1 To 2)
For lngI = 1 To lngCount
    lngMin = Evaluate("MIN(IF(" & rngData.Address & ">" & lngMax & "," & rngData.Address & "))")
    lngMax = Evaluate("MIN(IF((" & rngData.Offset(1).Address & ">" & rngData.Address & "+1)*(" & rngData.Address & ">" & lngMin & ")," & rngData.Address & "))")
    Cells(lngI, "B") = lngMin & IIf(lngMax, "-" & lngMax, "")
Next lngI
Columns(1).Delete
Set rngData = Nothing
End Sub
Reply With Quote