Solved

Creating ranges based on single values (sorted)

Posted on 2014-11-03
8
67 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
 
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
Is Your Active Directory as Secure as You Think?

More than 75% of all records are compromised because of the loss or theft of a privileged credential. Experts have been exploring Active Directory infrastructure to identify key threats and establish best practices for keeping data safe. Attend this month’s webinar to learn more.

 
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

Is Your Active Directory as Secure as You Think?

More than 75% of all records are compromised because of the loss or theft of a privileged credential. Experts have been exploring Active Directory infrastructure to identify key threats and establish best practices for keeping data safe. Attend this month’s webinar to learn more.

Question has a verified solution.

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

Dealing with unintended Excel Active-X resizing quirks (VBA code simulates "self correction") David Miller (dlmille) Intro Not everyone is a fan of Active-X controls in spreadsheets (as opposed to the UserForm approach, the older Form controls …
This article descibes how to create a connection between Excel and SAP and how to move data from Excel to SAP or the other way around.
The viewer will learn how to simulate a series of sales calls dependent on a single skill level and learn how to simulate a series of sales calls dependent on two skill levels. Simulating Independent Sales Calls: Enter .75 into cell C2 – “skill leve…
This Micro Tutorial demonstrates how to create Excel charts: column, area, line, bar, and scatter charts. Formatting tips are provided as well.

864 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

Need Help in Real-Time?

Connect with top rated Experts

21 Experts available now in Live!

Get 1:1 Help Now