Help on single and subsequent ranges within groups with vba

[pb0759]

Hello,
I am trying to get records placed into two different columns depending on each grouping of ranges on dn1 and Ext in table example below:
If dn1/ext is asingle range then needs to be separated with a comma ',", else is in subsequent ranges then separation with a dash "-"
Results would need to be per each group like in Ext Results and dn1 Results column.
Any help would be greatly appreciated.

Group	dn1	Ext	Ext Results	dn1 Results
Group A	\+19725551000	1000	1000,1031-1035,1055	\+19725551000,\+19725551031-\+19725551035,\+19725551055
Group A	\+19725551031	1031
Group A	\+19725551032	1032
Group A	\+19725551034	1034
Group A	\+19725551035	1035
Group A	\+19725551055	1055
Group B	\+19725551036	1036	1036-1037,1060	\+19725551036-\+19725551037,\+19725551060
Group B	\+19725551037	1037
Group B	\+19725551060	1060

<tbody>
</tbody>

 

[DanteAmor]

I'm glad to help you. I appreciate your kind comments.

 

[pb0759]

Hello again..
I have noticed a problem with another scenario and wondering if you could please help out?
If the numbers are all in order the code is not working as should.
Example:

Results
Loc	dn1	Ext	Ext Results	dn1 Results
Group A	\+19725551031	1031	1031	\+19725551031
Group A	\+19725551032	1032
Group A	\+19725551033	1033
Group A	\+19725551034	1034
Group A	\+19725551035	1035
Group B	\+19725551036	1036
Group B	\+19725551037	1037
Group B	\+19725551038	1038
Group C	\+19725551039	1039	1039	\+19725551039
Expected Results
Loc	dn1	Ext	Ext Results	dn1 Results
Group A	\+19725551031	1031	1031-1035	\+19725551031-\+19725551035
Group A	\+19725551032	1032
Group A	\+19725551033	1033
Group A	\+19725551034	1034
Group A	\+19725551035	1035
Group B	\+19725551036	1036	1036-1038	\+19725551036-\+19725551038
Group B	\+19725551037	1037
Group B	\+19725551038	1038
Group C	\+19725551039	1039	1039	\+19725551039

<tbody>
</tbody>

Also if all are in Group A then I just get the last output number.

 

[DanteAmor]

Try this

Sub subsequent()
    Dim ini As Long, c As Range, ant As String, dn1 As String, ext As String, sep As String
    ini = 2
    Range("D:E").ClearContents
    ant = Range("A" & ini)
    exa = Range("C" & ini)
    For Each c In Range("A2", Range("A" & Rows.Count).End(xlUp)(2))
        If ant <> c Then
            Cells(ini, "D").Value = "'" & Mid(ext, 2)
            Cells(ini, "E").Value = "'" & Mid(dn1, 2)
            dn1 = ""
            ext = ""
            ini = c.Row
        End If
        If c.Offset(, 2).Value - 1 = exa And ant = c Then sep = "-" Else sep = ","
        If c.Offset(, 2).Value + 1 <> c.Offset(1, 2).Value Or sep = "," Or c.Value <> c.Offset(1) Then
            dn1 = dn1 & sep & c.Offset(, 1)
            ext = ext & sep & c.Offset(, 2)
        End If
        ant = c
        exa = c.Offset(, 2)
    Next
End Sub

 

[pb0759]

YES Indeed! Works. Thank you ever so kindly this. You are the Best!

 

[DanteAmor]

YES Indeed! Works. Thank you ever so kindly this. You are the Best!

I liked to help you again. Thanks for the feedback.