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.