Solved

Creating ranges based on single values (sorted)

Posted on 2014-11-03
8
70 Views
Last Modified: 2014-11-04
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
0
Comment
Question by:NickHoward
  • 5
  • 3
8 Comments
 

Author Comment

by:NickHoward
ID: 40420113
Any help?
0
 
LVL 27

Expert Comment

by:Glenn Ray
ID: 40420205
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
 

Author Comment

by:NickHoward
ID: 40420323
Correct.

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

Hope I have answered your questions.

Thanks.
0
Independent Software Vendors: We Want Your Opinion

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

 
LVL 27

Expert Comment

by:Glenn Ray
ID: 40420426
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
 
LVL 27

Accepted Solution

by:
Glenn Ray earned 500 total points
ID: 40420544
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
 
LVL 27

Expert Comment

by:Glenn Ray
ID: 40420583
Thanks, but was there an issue with my solution that only rated a "Good" grade? :-/
0
 

Author Comment

by:NickHoward
ID: 40421089
Yeah as it is still slow. I got an example from another forum which takes 10 seconds.
0
 
LVL 27

Expert Comment

by:Glenn Ray
ID: 40421226
Could you post that solution here?  I'm sure it would be helpful to know how it sped up the process.  Thanks.
0

Featured Post

Online Training Solution

Drastically shorten your training time with WalkMe's advanced online training solution that Guides your trainees to action. Forget about retraining and skyrocket knowledge retention rates.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

When you see single cell contains number and text, and you have to get any date out of it seems like cracking our heads.
In Part II of this series, I will discuss how to identify all open instances of Excel and enumerate the workbooks, spreadsheets, and named ranges within each of those instances.
This Micro Tutorial demonstrate the bugs in Microsoft Excel for Mac with Pivot Charts.
Excel styles will make formatting consistent and let you apply and change formatting faster. In this tutorial, you'll learn how to use Excel's built-in styles, how to modify styles, and how to create your own. You'll also learn how to use your custo…

726 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question