Macro - breaks list of values into ranges


Posted by Jeff Lollar on September 19, 2001 4:09 PM

I would like to write a macro that takes a list of values and returns the list but broken up into ranges. The following example may help to explain what I am looking for.

Currently I get the following output:
46
47
48
52
54
69
70
71

I would like to get
46-48
52
54
69-71

Can you please give me some direction.

Thanks,
Jeff



Posted by Mark O'Brien on September 20, 2001 9:50 AM

I took your example numbers and pasted them onto Sheet1, cells A1:A8.

This macro will go through the numbers and when it comes to the end of a range it will list the range in cell B adjacent to the last value in the range, e.g. "46-48" will appear in cell B3.

Public Sub SetRanges()

'Declare Variables
Dim i As Integer
Dim j As Integer
Dim iRows As Integer
Dim rngFirstAddress As Range
Dim strRange As String
Dim iCount As Integer

'Initialise Variables
iRows = 8
Set FirstAddress = Sheets("Sheet1").Range("A1")
strRange = FirstAddress.Value
iCount = 0

For i = 1 To iRows
j = i - 1
With FirstAddress
If .Offset(i, 0).Value - .Offset(j, 0).Value <> 1 Then
If iCount > 0 Then
strRange = strRange & "-" & .Offset(j, 0).Value
End If
.Offset(j, 1).Value = strRange 'Put Range in Cell B
strRange = .Offset(i, 0).Value
iCount = 0
Else
iCount = iCount + 1
End If
End With
Next
End Sub

If you have any questions just repost.