Creating ranges based on single values (sorted)

Dear,

I have a list of serials which are random in sequence however sorted.

If some serials in short sequence (+1 incremental), I want them to show as range while display the serials as it is if not in sequence.

See the attached excel (Column E & F) as my desired result.

Hope to get  a formula or a macro to do the job.

Thanks.
convert-to-range.xlsx
NickHowardAsked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

NickHowardAuthor Commented:
Any help?
0
Glenn RayExcel VBA DeveloperCommented:
Just to clarify by example.  Should these cells be these values?
E46: 101588948
F46: 101588953

Also, do you want empty rows to remain or do you want all the values to be adjacent?
0
NickHowardAuthor Commented:
Correct.

I prefer to copy the range to another sheet without any empty rows.

Hope I have answered your questions.

Thanks.
0
Cloud Class® Course: Microsoft Azure 2017

Azure has a changed a lot since it was originally introduce by adding new services and features. Do you know everything you need to about Azure? This course will teach you about the Azure App Service, monitoring and application insights, DevOps, and Team Services.

Glenn RayExcel VBA DeveloperCommented:
Yep!  The following code will create a new sheet with a set of columns showing all serial numbers and related ranges as in your example:
 
Option Explicit
Sub Transfer_Serial_Nos()
    Dim rng, rng2 As Range
    Dim cl As Object
    Dim intRow As Integer
    
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
    On Error Resume Next
    Sheets("Result").Delete
    Sheets("Sheet1").Copy after:=Sheets("Sheet1")
    ActiveSheet.Name = "Result"
    Range("B:F").Delete
    
    Set rng = Range("A3", Range("A3").End(xlDown))
    intRow = 1
    For Each cl In rng
        If Val(cl.Offset(1, 0).Value) = Val(cl.Value) + 1 Then
            intRow = intRow - 1
            cl.Offset(intRow, 1).Value = cl.Offset(1, 0).Value
            If rng2 Is Nothing Then
                Set rng2 = Range(cl.Offset(1, 0).Address)
            Else
                Set rng2 = Union(rng2, Range(cl.Offset(1, 0).Address))
            End If
        Else
            intRow = 1
        End If
    Next cl
    rng2.EntireRow.Delete
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    MsgBox "Done."
End Sub

Open in new window


It will note all rows to delete (in rng2) and then delete those rows on completion.

The process took just over five minutes to complete on my PC (40K rows).  I didn't expect it to take that long.

Example file with macro attached.

Regards,
-Glenn
EE-convert-to-range.xlsm
0
Glenn RayExcel VBA DeveloperCommented:
This code runs MUCH faster (about one minute):
Sub Transfer_Ser_Nos2()
    Dim varTest As Variant
    Dim boolInRange As Boolean
    
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
    On Error Resume Next
    Sheets("Result").Delete
    Sheets("Sheet1").Copy after:=Sheets("Sheet1")
    ActiveSheet.Name = "Result"
    Range("B:F").Delete

    Range("A3").Select
    Do Until ActiveCell.Value = ""
        If boolInRange = False Then varTest = ActiveCell.Value
        If Val(ActiveCell.Offset(1, 0).Value) = Val(varTest) + 1 Then
            ActiveCell.Offset(0, 1).Value = ActiveCell.Offset(1, 0).Value
            varTest = ActiveCell.Offset(0, 1).Value
            boolInRange = True
            ActiveCell.Offset(1, 0).EntireRow.Delete
        Else
            ActiveCell.Offset(1, 0).Select
            boolInRange = False
        End If
    Loop
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    MsgBox "Done."

End Sub

Open in new window


I've added it to the example workbook.

Regards,
-Glenn
EE-convert-to-range.xlsm
0

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
Glenn RayExcel VBA DeveloperCommented:
Thanks, but was there an issue with my solution that only rated a "Good" grade? :-/
0
NickHowardAuthor Commented:
Yeah as it is still slow. I got an example from another forum which takes 10 seconds.
0
Glenn RayExcel VBA DeveloperCommented:
Could you post that solution here?  I'm sure it would be helpful to know how it sped up the process.  Thanks.
0
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Microsoft Excel

From novice to tech pro — start learning today.