• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

change from sequence to range

shili12

shili12

Member
i have them in sequential order,
how do i change to range as below ?? formula and power query solutions too are fine.

Namefromto
Jawwab Insurance AgenciesB13451227B13455432
B13455439B13455464
PANTHERA INSURANCE AGENCYB13271712
B13329527B13329529
B13340636B13340640
B13368804B13368808
B13371368B13371371
B13371376B13371388
 

Attachments

According to your attachment a Windows VBA demonstration to paste only to the 'results' worksheet module :​
Code: 
Sub DemoW1()
        Dim oRE(2) As Object, F&, L&, R&, P%, T%
   With Sheet11.[A1].CurrentRegion.Rows
        If .Count < 3 Then Beep: Exit Sub
        Set oRE(2) = CreateObject("VBScript.RegExp")
        UsedRange.Offset(1).Clear
        Application.ScreenUpdating = False
       .Sort .Cells(6), 1, .Cells(2), , 1, , , 1
        oRE(2).Pattern = "(\D*)(\d*)"
        F = 2
        L = 1
    For R = F To .Count
        P = R And 1
        Set oRE(P) = oRE(2).Execute(.Cells(R, 2))
        T = -(.Cells(R, 6) <> .Cells(R, 6)(0))
        If T = 0 Then T = oRE(P)(0).SubMatches(0) <> oRE(1 - P)(0).SubMatches(0) Or _
                      Val(oRE(P)(0).SubMatches(1)) - Val(oRE(1 - P)(0).SubMatches(1)) > 1
     If T Then
        If R > F Then Cells(L, 3) = .Cells(R, 2)(0)
           F = R + 1
           L = L + 1
        If T = 1 Then
            Cells(L, 1).Borders(8).Weight = 2
            Rows(L).Columns("A:B") = Array(.Cells(R, 6), .Cells(R, 2))
        Else
            Cells(L, 2) = .Cells(R, 2)
        End If
     End If
    Next
        If R - 1 > F Then Cells(L, 3) = .Cells(R, 2)(0)
   End With
        Erase oRE
        For P = 7 To 9:  UsedRange.Columns(1).Borders(P).Weight = 2:  Next
        UsedRange.Columns("B:C").Borders.Weight = 2
        UsedRange.NumberFormat = "_0@ "
        UsedRange.VerticalAlignment = xlCenter
        UsedRange.Columns.AutoFit
        Application.ScreenUpdating = True
End Sub
 
The attached contains a Power Query solution rather than VBA. See table at cell E1 of ther results sheet. This just needs refreshing like a pivot table if the source data should change.
I've added a pivot table at cell I1 based on the new table to give you the same style of output that you asked for, although I think you can do more with the raw table.
 

Attachments

For a better word for it. I could not have written urgent as this data is going in papers by Thursday with use of your formula. 17000 lines had to be summarized. If I said urgent, it would be a violation. Thanks alot for yr assistance. You've saved me hours of toil.
 
Like 'va tutto bene', no problem, you're welcome.​
​
Next time you may indicate you have « some short delay, if possible etc … »​
and according to your small attachment give more details like about the rows size​
as if I knew there are 17 000 I certainly wrote a different code - is my previous demonstration slow ? -​
like also columns criterion (2 & 6) and if column 2 always starts with B or at least with a single letter,​
again it should be a different code, easier and working on every platform and not only under Windows.​
​
 
perfect, it worked perfectly without a glitch or was not even slow !! i did exactly as you instructed, i cannot know how to express my gratitude. If only you could get compensated by likes we give you !! i spent over 3 hours or so on gemini, chatgpt, and copilot testing all scenarios and rephrasing myself but to no avail.
Xxxx Insurance AgencyB13222463B13222495
B13224297B13224330
B13282077B13282080
B13283294B13283314
B13288056B13288068
B13293644
B13293650B13293652
B13293658B13293673
B13307871B13307905
B13309988B13310017
B13314467B13314503
B13328121B13328155
B13329650B13329695
B13337434B13337465
B13340564B13340596
B13349613B13349647
B13354589B13354594
B13357263B13357272
B13365803B13365807
B13368184B13368213
B13371297B13371304
B13374504B13374537
B13383252B13383296
B13399951B13400008
B13406225B13406227
B13406320B13406339
B13407422B13407457
B13412796B13412828
B13419329B13419379
B13420840B13420892
B13425816B13425877
B13434099
B13434103B13434137
B13443601B13443638
B13443643B13443645
B13448404B13448456
B13451230B13451235
B13451239B13451255
B13451259B13451263
B13463281B13463282
B13464451B13464480
B13465587B13465602
B13465607B13465609
B13465613B13465629
B13476115B13476135
B13476142
B13484393B13484417
B13484953B13484956
B13487776B13487795
B13492790B13492832
B13495844B13495876
B13495882B13495917
B13497277B13497332
B13497800B13497849
B13502735B13502749
B13502751B13502780
B13502783B13502789
B13513698B13513747
B13519468B13519498
B13519501B13519535
B13519537B13519539
B13520726B13520746
B13527653B13527684
B13527687B13527701
B13528279B13528285
B13530486B13530510
B13530514B13530530
B13531040B13531044
B13531047B13531049
B13531053B13531061
B13531577B13531628
B13532215B13532252
B13532255B13532257
B13532260B13532267
B13535019B13535050
B13541045B13541079
B13541082B13541097
B13543955B13543967
B13543971B13544004
B13544596B13544627
B13554063B13554095
 
Thanks for your revert !​
​
If column 2 data starts always with 'B' or at least with only a single letter then my VBA procedure​
can be simplified without any regular expression (so working whatever on Mac like under Windows)​
and of course optimized for 17 000 rows, easier code and could be slightly faster …​
​
shili12 said:
gemini, chatgpt, and copilot
Click to expand...
I only saw working ways from those AI with people who already well know VBA so they do not need any AI !​
I'm helping someone on a project started with Copilot : ugly code, often not working and​
when it may work many useless things so not such efficient. I had to restart from blank …​
​
 
shili12 said:
i spent over 3 hours or so on gemini, chatgpt, and copilot testing all scenarios and rephrasing myself but to no avail.
Click to expand...
The easy beginner way : filling a helper column as a process criteria with a beginner level worksheet formula​
like the kid Excel beginner solved this (I sent him as a logic training exercice).​
Could be less difficult when using an AI …​
​
According to the 17K data rows, under a VBA procedure filling a helper column can be avoided in your case​
but using the same kid logic with the worksheet formula directly evaluated in a variable,​
this faster Excel basics VBA demonstration assumes column 2 contains only a single letter before digits,​
to paste only to the 'results' worksheet module :​
Code: 
Sub Demo1()
  Const E = "IF({1},(LEFT(B2:B#,1)&MID(B2:B#,2,LEN(B2:B#))-1<>B1:B§)+(F2:F#<>F1:F§))"
    Dim V, W, S$(), F&, R&, L&
        UsedRange.Offset(1).Clear
   With Sheet11.[A1].CurrentRegion.Rows
'       .Sort .Cells(6), 1, .Cells(2), , 1, , , 1
        V = .Range("B2:F" & .Count)
        W = .Parent.Evaluate(Replace(Replace(E, "#", .Count), "§", .Count - 1))
   End With
        ReDim S(1 To UBound(W), 2)
        F = 1
    For R = F To UBound(W)
     If W(R, 1) Then
        If R > F Then S(L, 2) = V(R - 1, 1)
        F = R + 1
        L = L + 1
        If W(R, 1) = 2 Then S(L, 0) = V(R, 5)
        S(L, 1) = V(R, 1)
     End If
    Next
    If L Then
         If R - 1 > F Then S(L, 2) = V(R - 1, 1)
    With [A2].Resize(L, 3)
'        .Borders.Weight = 2
'        .NumberFormat = "_0@ "
        .Value = S
        .Columns.AutoFit
    End With
    End If
End Sub
 
You must log in or register to reply here.
Back
Top