Sub PutBins()
' Splits out run of numbers based on gaps found
' NOTE: Assumes the numbers are sorted ascending.
' IMPORTANT NOTE: Ensure that ONLY the desired data is in the data column. If there is other data BELOW the end of the actual data, it gets included because
' the program ascetains the LAST ROW used in the specified column, denoted by the STARTDATACOL Const
Const StartDataRow = 2 'The row where the source data starts (NOT including the header). If header in Row 1, then data will start in row 2.
Const StartDataCol = 1 'The column containing the data. For column A, put 1, for B, 2 and so on (A=1, B=2, C=3, D=4.. .. ..)
Const EndDataRow = 1048576 'Highest Row in Excel. Do not alter.
Const SheetName = "Sheet3" 'Sheetname to work in. Ensure you've got the correct sheetname BEFORE running!
Const StartDataOutputRow = 1 'The ROW where you want the BIN data to go (the grouped information)
Const StartDataOutputCol = 13 'The COLUMN where you want the BIN data to go. A=1, B=2, C=3 and so on.
Dim LastRow As Integer
Dim rng As Range
Dim Ptr As Integer
Dim LstPtr As Integer
Dim Mkr As Integer
Dim Cntr As Integer
Dim MArray() As Integer
Dim ArrayCnt As Integer
'Get the Last Row in the worksheet
LastRow = Sheets(SheetName).Range(Cells(StartDataRow, StartDataCol).Address, Cells(EndDataRow, StartDataCol).Address).Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
Cntr = 0: LstPtr = 0: ArrayCnt = 0
For Each rng In Sheets(SheetName).Range(Cells(StartDataRow, StartDataCol).Address, Cells(LastRow, StartDataCol).Address)
Cntr = Cntr + 1
If Cntr = 1 Then Mkr = rng.Value
Ptr = rng.Value
If LstPtr <> Ptr - 1 And Ptr <> 0 Then
ArrayCnt = ArrayCnt + 1
ReDim Preserve MArray(1 To 2, 1 To ArrayCnt)
MArray(1, ArrayCnt) = Mkr
MArray(2, ArrayCnt) = LstPtr
Mkr = Ptr
End If
LstPtr = Ptr
Next rng
If Ptr <> 0 Then
ArrayCnt = ArrayCnt + 1
ReDim Preserve MArray(1 To 2, 1 To ArrayCnt)
MArray(1, ArrayCnt) = Mkr
MArray(2, ArrayCnt) = LstPtr
Mkr = Ptr
End If
For Cntr = 1 To ArrayCnt
Sheets(SheetName).Range(Cells(StartDataOutputRow + Cntr - 1, StartDataOutputCol).Address).Value = "'" & MArray(1, Cntr) & " - " & MArray(2, Cntr)
Next Cntr
End Sub
