VBA code to identify a continuous range

[rshnkmr39]

Hi

If I have a range

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15

my macro should pick up the start range as 1 and end range as 15

if the range is

1 3 4 5 6 9 11 12 13 14 15

my macro shoul pick up

1 as a start 1 ,3 as start2 range and 5 as end2 , 9 as start3, 11 as start 4 and 15 as end15

if the range is

1 2 3 4 7 9 10 11 12 13 then

1 is start1 4 is end1, 7 is start2, 9 is start3 13 is end3

or even if my macro can high light the ones in color it is fine

Basically identify a range and pick the start and end for each of the range and delete the inbetween numbers and retain the number which doesnt belong to the continuous series

[MickG]

Try this on numbers in row 1.
NB:- See code comments to delete or Colour unwanted columns !!!

Sub MG07Nov04
Dim Lst As Long
Dim c As Long
Dim n As Long
Dim Rng As Range
Lst = Cells("1", Columns.Count).End(xlToLeft).Column
For n = 1 To Lst
    If n = 1 Or n = Lst Then
        Cells(1, n).Interior.Color = vbGreen
    ElseIf Not Cells(1, n - 1) + 1 = Cells(1, n) Or Not Cells(1, n) + 1 = Cells(1, n + 1) Then
        Cells(1, n).Interior.Color = vbGreen
    Else
        If Rng Is Nothing Then
            Set Rng = Cells(1, n)
        Else
            Set Rng = Union(Rng, Cells(1, n))
        End If
    End If
Next n
   'User the Line below to Colour unwanted columns
   'If Not Rng Is Nothing Then Rng.Interior.ColorIndex = 6
   
   'Use the line below to delete unwanted columns
   If Not Rng Is Nothing Then Rng.EntireColumn.Delete

MsgBox "Run"
End Sub

Regards Mick

[rshnkmr39]

Hi this code removes the unwanted set of numbers..But needs to return the result in sets
like

1 to 4 is consequitive numbers so remove 2 n 3
9 to 13 is consequitive so remove 10,11 and 12
1-4,7,9-13

[MickG]

On the basis you want each set in a different cell, try this.
Results start "A5"

Sub MG08Nov37
Dim Lst As Long, n As Long
Dim Str As String, Sp As Variant
Dim nSp As Variant
Lst = Cells("1", Columns.Count).End(xlToLeft).Column

For n = 1 To Lst
   If n = 1 Then
        Str = Cells(1, n)
   ElseIf Cells(1, n) = Cells(1, n - 1) + 1 Then
        Str = Str & "#" & Cells(1, n)
   Else
         Str = Str & "," & Cells(1, n)
    End If
Next n
Sp = Split(Str, ",")
    For n = 0 To UBound(Sp)
        If InStr(Sp(n), "#") Then
            nSp = Split(Sp(n), "#")
            Sp(n) = nSp(0) & "-" & nSp(UBound(nSp))
        End If
 Next n
With Range("A5")
    .EntireRow.Clear
    .Resize(, UBound(Sp) + 1) = Sp
End With
End Sub

Regards Mick

[rshnkmr39]

WOw.This is amazing.Thanks a ton.

[MickG]

You're welcome