Solved

Creating ranges based on single values (sorted)

Posted on 2014-11-03
8
64 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
What Is Threat Intelligence?

Threat intelligence is often discussed, but rarely understood. Starting with a precise definition, along with clear business goals, is essential.

 
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

Maximize Your Threat Intelligence Reporting

Reporting is one of the most important and least talked about aspects of a world-class threat intelligence program. Here’s how to do it right.

Join & Write a Comment

Suggested Solutions

Title # Comments Views Activity
Query Missing Money orders... 6 62
excel file 5 44
Excel VBA - copying formats 7 19
Out of stack space (Error 28) 5 23
Drop Down List with Unique/Distinct Values (enhancing the Combo-Box with a few steps and a little code) David miller (dlmille) Intro Have you ever created a data validation list from a database field or spreadsheet column (e.g., Zip Codes or Co…
How to quickly and accurately populate Word documents with Excel data, charts and images (including Automated Bookmark generation) David Miller (dlmille) Synopsis In this article you’ll learn how to use ExcelToWord! to copy data,charts, shapes …
The viewer will learn how to use a discrete random variable to simulate the return on an investment over a period of years, create a Monte Carlo simulation using the discrete random variable, and create a graph to represent the possible returns over…
Graphs within dashboards are meant to be dynamic, representing data from a period of time that will change each time the dashboard is updated with new data. Rather than update each graph to point to a different set within a static set of data, t…

708 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

18 Experts available now in Live!

Get 1:1 Help Now