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.
[TABLE="class: grid, width: 500, align: center"]
<tbody>[TR]
[TD]Group[/TD]
[TD]dn1[/TD]
[TD]Ext [/TD]
[TD]Ext Results[/TD]
[TD]dn1 Results[/TD]
[/TR]
[TR]
[TD]Group A[/TD]
[TD]\+19725551000[/TD]
[TD]1000[/TD]
[TD]1000,1031-1035,1055[/TD]
[TD]\+19725551000,\+19725551031-\+19725551035,\+19725551055[/TD]
[/TR]
[TR]
[TD]Group A[/TD]
[TD]\+19725551031[/TD]
[TD]1031[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Group A[/TD]
[TD]\+19725551032[/TD]
[TD]1032[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Group A[/TD]
[TD]\+19725551034[/TD]
[TD]1034[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Group A[/TD]
[TD]\+19725551035[/TD]
[TD]1035[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Group A[/TD]
[TD]\+19725551055[/TD]
[TD]1055[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Group B[/TD]
[TD]\+19725551036[/TD]
[TD]1036[/TD]
[TD]1036-1037,1060[/TD]
[TD]\+19725551036-\+19725551037,\+19725551060[/TD]
[/TR]
[TR]
[TD]Group B[/TD]
[TD]\+19725551037[/TD]
[TD]1037[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Group B[/TD]
[TD]\+19725551060[/TD]
[TD]1060[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]

 

[DanteAmor]

I assume the data starts in A2

Try:

Sub subsequent()
    Dim ini As Long, c As Range, ant As String, dn1 As String, ext As String
    ini = 2
    ant = Range("A" & 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
        dn1 = dn1 & "," & c.Offset(, 1)
        ext = ext & "," & c.Offset(, 2)
        ant = c
    Next
End Sub

 

[pb0759]

Thank you so much for your quick response. It is almost, however I need to a dash "-", instead of a comma when the number are in subsequent order within each group.
For example on Group A the following result and expected results:

Ext Result:[TABLE="width: 166"]
<tbody>[TR]
[TD="width: 166"]1000,1033,1034,1035,1055[/TD]
[/TR]
</tbody>[/TABLE]
Expected Result: [TABLE="width: 166"]
<tbody>[TR]
[TD="width: 166"]1036,1037,1060[/TD]
[/TR]
</tbody>[/TABLE]

dn1 Result: [TABLE="width: 386"]
<tbody>[TR]
[TD="width: 386"]\+19725551036,\+19725551037,\+19725551060
Espected Result:
[TABLE="width: 386"]
<tbody>[TR]
[TD="width: 386"]\+19725551036-\+19725551037,\+19725551060[/TD]
[/TR]
</tbody>[/TABLE]
[/TD]
[/TR]
</tbody>[/TABLE]

 

[pb0759]

Sorry typo on ext Result
Ext Result:[TABLE="class: cms_table, width: 166"]
<tbody>[TR]
[TD="width: 166"]1000,1033,1034,1035,1055[/TD]
[/TR]
</tbody>[/TABLE]

Expected Result:[TABLE="class: cms_table, width: 166"]
<tbody>[TR]
[TD="width: 166"]1000,1033-1035,1055[/TD]
[/TR]
</tbody>[/TABLE]


dn1 Result:[TABLE="width: 386"]
<tbody>[TR]
[TD="width: 386"]\+19725551000,\+19725551033,\+19725551034,\+19725551035,\+19725551055[/TD]
[/TR]
</tbody>[/TABLE]
[TABLE="width: 386"]
<tbody>[TR]
[TD="width: 386"]
Expected [TABLE="width: 386"]
<tbody>[TR]
[TD="width: 386"]\+19725551000,\+19725551033-\+19725551035,\+19725551055[/TD]
[/TR]
</tbody>[/TABLE]
[/TD]
[/TR]
</tbody>[/TABLE]

 

[DanteAmor]

You have this

<table border="1" cellspacing="0" style="font-family:Calibri,Arial; font-size:11pt; background-color:#ffffff; "> <colgroup><col style="font-weight:bold; width:30px; " /><col style="width:76.04px;" /><col style="width:134.02px;" /><col style="width:76.04px;" /></colgroup><tr style="background-color:#cacaca; text-align:center; font-weight:bold; font-size:8pt; "><td > </td><td >A</td><td >B</td><td >C</td></tr><tr style="height:19px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >1</td><td style="background-color:#92d050; font-weight:bold; text-align:center; ">Group</td><td style="background-color:#92d050; font-weight:bold; text-align:center; ">dn1</td><td style="background-color:#92d050; font-weight:bold; text-align:center; ">Ext</td></tr><tr style="height:19px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >2</td><td >Group A</td><td >\+19725551000</td><td style="text-align:right; ">1000</td></tr><tr style="height:19px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >3</td><td >Group A</td><td >\+19725551031</td><td style="text-align:right; ">1031</td></tr><tr style="height:19px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >4</td><td >Group A</td><td >\+19725551032</td><td style="text-align:right; ">1032</td></tr><tr style="height:19px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >5</td><td >Group A</td><td >\+19725551034</td><td style="text-align:right; ">1034</td></tr><tr style="height:19px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >6</td><td >Group A</td><td >\+19725551035</td><td style="text-align:right; ">1035</td></tr><tr style="height:19px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >7</td><td >Group A</td><td >\+19725551055</td><td style="text-align:right; ">1055</td></tr></table>

Expected Result:
1000, 1031-
1034-
1055

There is no 1033 in the table

 

[pb0759]

Oh, yes sorry about that. I am working on two PC's and but wrong about on my samples.
It could be a combination of any including many groups.
So let me try again
Ext Expected result:
1000,1031-1032, 1034-1035, 1055
dn1 Expectd result:
\+19725551000,\+19725551031-\+19725551032,\+19725551034-\+19725551035,\+19725551055

And thanks again for your prompt response

 

[DanteAmor]

Ok, 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
    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 Then sep = "-" Else sep = ","
        dn1 = dn1 & sep & c.Offset(, 1)
        ext = ext & sep & c.Offset(, 2)
        ant = c
        exa = c.Offset(, 2)
    Next
End Sub

 

[pb0759]

It works until the ranges change. Getting closer
Example in Group A:
1000,1033-1034-1035,1055 should be 1000,1033-1035,1055. (leave out the 1034 since it is in between 1033 & 1035)
[TABLE="width: 847"]
<colgroup><col><col><col><col><col></colgroup><tbody>[TR]
[TD]Loc[/TD]
[TD]dn1[/TD]
[TD]Ext[/TD]
[TD]Ext Results[/TD]
[TD]dn1 Results[/TD]
[/TR]
[TR]
[TD]Group A[/TD]
[TD]\+19725551000[/TD]
[TD="align: right"]1000[/TD]
[TD]1000,1033-1034-1035,1055[/TD]
[TD]\+19725551000,\+19725551033-\+19725551034-\+19725551035,\+19725551055[/TD]
[/TR]
[TR]
[TD]Group A[/TD]
[TD]\+19725551033[/TD]
[TD="align: right"]1033[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Group A[/TD]
[TD]\+19725551034[/TD]
[TD="align: right"]1034[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Group A[/TD]
[TD]\+19725551035[/TD]
[TD="align: right"]1035[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Group A[/TD]
[TD]\+19725551055[/TD]
[TD="align: right"]1055[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Group B[/TD]
[TD]\+19725551036[/TD]
[TD="align: right"]1036[/TD]
[TD]1036-1037,1060[/TD]
[TD]\+19725551036-\+19725551037,\+19725551060[/TD]
[/TR]
[TR]
[TD]Group B[/TD]
[TD]\+19725551037[/TD]
[TD="align: right"]1037[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Group B[/TD]
[TD]\+19725551060[/TD]
[TD="align: right"]1060[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Group C[/TD]
[TD]\+19725551061[/TD]
[TD="align: right"]1061[/TD]
[TD]1061[/TD]
[TD]\+19725551061[/TD]
[/TR]
</tbody>[/TABLE]

 

[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
    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 Then sep = "-" Else sep = ","
        If c.Offset(, 2).Value + 1 <> c.Offset(1, 2).Value Or sep = "," Then
            dn1 = dn1 & sep & c.Offset(, 1)
            ext = ext & sep & c.Offset(, 2)
        End If
        ant = c
        exa = c.Offset(, 2)
    Next
End Sub

If you have more cases that do not work, you could make a compilation of all the cases you need, since I do not know them, I'm only doing case by case you submit.

 

[pb0759]

Awesome! You Nailed it! Thank you so very much! You are the BEST Ever!!!! Have a good evening and again I really appreciate all of your help