Show Missing Numbers

I

ilak1008

New Member
Joined
Aug 2, 2010
Messages
38
Hi all

Could you please help me show the missing numbers in Station column using Excel VBA? I tried to use conditional formatting but that's not exactly what I want to do. On line 1003, station 5000 is also missing. I want to put all missing sequential station numbers on another sheet. Thanks.

Line Station Difference
<table border="0" cellpadding="0" cellspacing="0" width="192"><tbody></tbody></table><table border="0" cellpadding="0" cellspacing="0" width="192"> <colgroup><col style="width:48pt" span="3" width="64"> </colgroup><tbody><tr style="height:15.0pt" height="20"> <td class="xl65" style="height:15.0pt;width:48pt" height="20" width="64">1000</td> <td class="xl65" style="border-left:none;width:48pt" width="64">5069</td> <td class="xl65" style="border-left:none;width:48pt" width="64">1</td> </tr> <tr style="height:15.0pt" height="20"> <td class="xl65" style="height:15.0pt;border-top:none" height="20">1000</td> <td class="xl65" style="border-top:none;border-left:none">5070</td> <td class="xl65" style="border-top:none;border-left:none;font-size:11.0pt; color:white;font-weight:400;text-decoration:none;text-underline-style:none; text-line-through:none;font-family:Calibri;border:.5pt solid windowtext; background:red;mso-pattern:black none">2</td> </tr> <tr style="height:15.0pt" height="20"> <td class="xl65" style="height:15.0pt;border-top:none" height="20">1000</td> <td class="xl65" style="border-top:none;border-left:none">5072</td> <td class="xl65" style="border-top:none;border-left:none">1</td> </tr> <tr style="height:15.0pt" height="20"> <td class="xl65" style="height:15.0pt;border-top:none" height="20">1000</td> <td class="xl65" style="border-top:none;border-left:none">5073</td> <td class="xl65" style="border-top:none;border-left:none">1</td> </tr> <tr style="height:15.0pt" height="20"> <td class="xl65" style="height:15.0pt;border-top:none" height="20">1000</td> <td class="xl65" style="border-top:none;border-left:none">5074</td> <td class="xl65" style="border-top:none;border-left:none">1</td> </tr> <tr style="height:15.0pt" height="20"> <td class="xl65" style="height:15.0pt;border-top:none" height="20">1000</td> <td class="xl65" style="border-top:none;border-left:none">5075</td> <td class="xl65" style="border-top:none;border-left:none;font-size:11.0pt; color:white;font-weight:400;text-decoration:none;text-underline-style:none; text-line-through:none;font-family:Calibri;border:.5pt solid windowtext; background:red;mso-pattern:black none">4</td> </tr> <tr style="height:15.0pt" height="20"> <td class="xl65" style="height:15.0pt;border-top:none" height="20">1000</td> <td class="xl65" style="border-top:none;border-left:none">5079</td> <td class="xl65" style="border-top:none;border-left:none">1</td> </tr> <tr style="height:15.0pt" height="20"> <td class="xl65" style="height:15.0pt;border-top:none" height="20">1000</td> <td class="xl65" style="border-top:none;border-left:none">5080</td> <td class="xl65" style="border-top:none;border-left:none">1</td> </tr> <tr style="height:15.0pt" height="20"> <td class="xl65" style="height:15.0pt;border-top:none" height="20">1000</td> <td class="xl65" style="border-top:none;border-left:none">5081</td> <td class="xl65" style="border-top:none;border-left:none">1</td> </tr> <tr style="height:15.0pt" height="20"> <td class="xl65" style="height:15.0pt;border-top:none" height="20">1000</td> <td class="xl65" style="border-top:none;border-left:none">5082</td> <td class="xl65" style="border-top:none;border-left:none">-81</td> </tr> <tr style="height:15.0pt" height="20"> <td class="xl65" style="height:15.0pt;border-top:none" height="20">1003</td> <td class="xl65" style="border-top:none;border-left:none">5001</td> <td class="xl65" style="border-top:none;border-left:none">1
</td> </tr> </tbody></table>
 
Sort by date Sort by votes
So are all the "lines" supposed to have the same stations? For instance, in one of your data sets the stations range from 5000 to 5082. Is it the case that all the lines should have this same series of stations from 5000 to 5082?
 
Upvote 0

Excel Facts

Can Excel fill bagel flavors?
You can teach Excel a new custom list. Type the list in cells, File, Options, Advanced, Edit Custom Lists, Import, OK
xenou said:
So are all the "lines" supposed to have the same stations? For instance, in one of your data sets the stations range from 5000 to 5082. Is it the case that all the lines should have this same series of stations from 5000 to 5082?
Click to expand...

Some of the lines have same series of stations but not all.
 
Upvote 0
This is my attempt - I tried to minimize the use of iteration (loops) although it's still the basic strategy. Seems to work so far but of course it needs to be tested thoroughly under more realistic conditions. What I did here was create a basic algorithm to find the missing stations - the code creates its own test data so that you can run it as is to demonstrate the results.

For convenience, you can just download a test workbook if you wish:
<a href="http://northernocean.net/etc/mrexcel/20110915_Line_Station3.zip">Sample Workbook</a>
sha256 checksum (zip file): 996dcf4c745896c25d4792473efab5cf55f5ec7377ed2eb481d6fd8e891c459f

Code: 
[COLOR="Navy"]Option Explicit[/COLOR]

[COLOR="Navy"]Sub[/COLOR] Foo()

[COLOR="Navy"]Dim[/COLOR] Lines [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Object[/COLOR] [COLOR="SeaGreen"]'//Scripting.Dictionary[/COLOR]
[COLOR="Navy"]Dim[/COLOR] rs [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Object[/COLOR] [COLOR="SeaGreen"]'//ADODB.Recordset[/COLOR]
[COLOR="Navy"]Dim[/COLOR] rDat [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Dim[/COLOR] thisLine [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="Navy"]Dim[/COLOR] i [COLOR="Navy"]As[/COLOR] Long, j [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="Navy"]Dim[/COLOR] a, b
[COLOR="Navy"]Dim[/COLOR] myMin [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="Navy"]Dim[/COLOR] myMax [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="Navy"]Dim[/COLOR] results()
[COLOR="Navy"]Dim[/COLOR] resultsCount [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="Navy"]Dim[/COLOR] wb [COLOR="Navy"]As[/COLOR] Workbook
    
[COLOR="SeaGreen"]'Given two sets of numbers, where column 1 is "Lines" and Column 2 is "Stations",[/COLOR]
[COLOR="SeaGreen"]'to seek for missing stations within each Line.[/COLOR]
[COLOR="SeaGreen"]'Ex:[/COLOR]
[COLOR="SeaGreen"]' 1000 1[/COLOR]
[COLOR="SeaGreen"]' 1000 2[/COLOR]
[COLOR="SeaGreen"]' 1000 4[/COLOR]
[COLOR="SeaGreen"]' 1000 5[/COLOR]
[COLOR="SeaGreen"]'Return would be:[/COLOR]
[COLOR="SeaGreen"]' 1000 3[/COLOR]
[COLOR="SeaGreen"]'Since this is the missing station.[/COLOR]

[COLOR="SeaGreen"]'Notes:[/COLOR]
[COLOR="SeaGreen"]'Result set includes the first and last station for each line[/COLOR]
[COLOR="SeaGreen"]'It is assumed that all stations and lines are Numeric values (Integers)[/COLOR]
[COLOR="SeaGreen"]'Any stations with value of -1 are ignored[/COLOR]
[COLOR="SeaGreen"]'This is an iterative process so it is not intended for large data sets[/COLOR]
[COLOR="SeaGreen"]' (i.e., hundreds of thousands of records)[/COLOR]
    
[COLOR="SeaGreen"]'--------------------------------------------------------------------------------[/COLOR]
    
    [COLOR="Navy"]Call[/COLOR] TestWorkbooks [COLOR="SeaGreen"]'//Use while testing - creates a test data set[/COLOR]
    
    [COLOR="Navy"]Set[/COLOR] wb = ActiveWorkbook
    
    [COLOR="SeaGreen"]'//Get Data from Cells[/COLOR]
    [COLOR="Navy"]Set[/COLOR] rDat = wb.Sheets(1).Cells(1, 1).CurrentRegion
    [COLOR="Navy"]If[/COLOR] [COLOR="Navy"]Not[/COLOR] IsNumeric(rDat.Cells(1).Value) [COLOR="Navy"]Then[/COLOR] [COLOR="SeaGreen"]'//Exclude Headers[/COLOR]
        [COLOR="Navy"]Set[/COLOR] rDat = rDat.Offset(1).Resize(rDat.Rows.Count - 1, rDat.Columns.Count)
    [COLOR="Navy"]End[/COLOR] [COLOR="Navy"]If[/COLOR]
    a = rDat.Value
    
    [COLOR="SeaGreen"]'//Pull Distinct Line Numbers[/COLOR]
    [COLOR="Navy"]Set[/COLOR] Lines = CreateObject("Scripting.Dictionary")
    [COLOR="Navy"]For[/COLOR] i = LBound(a, 1) [COLOR="Navy"]To[/COLOR] UBound(a, 1)
        [COLOR="Navy"]If[/COLOR] [COLOR="Navy"]Not[/COLOR] Lines.Exists(CStr(a(i, 1))) [COLOR="Navy"]Then[/COLOR]
            Lines.Add CStr(a(i, 1)), CLng(a(i, 1))
        [COLOR="Navy"]End[/COLOR] [COLOR="Navy"]If[/COLOR]
    [COLOR="Navy"]Next[/COLOR] i
    
    [COLOR="SeaGreen"]'//Populate Recordset with Dataset (Lines and Stations)[/COLOR]
    [COLOR="SeaGreen"]'//   ~~ Exclude rows with -1 as station number[/COLOR]
    [COLOR="Navy"]Set[/COLOR] rs = CreateObject("ADODB.Recordset")
    [COLOR="Navy"]With[/COLOR] rs
        .Fields.Append "Line", 3 [COLOR="SeaGreen"]'adInteger[/COLOR]
        .Fields.Append "Station", 3
        .Open
        thisLine = -999999
        [COLOR="Navy"]For[/COLOR] i = 1 [COLOR="Navy"]To[/COLOR] UBound(a, 1)
            [COLOR="Navy"]If[/COLOR] a(i, 2) <> -1 [COLOR="Navy"]Then[/COLOR]
                .AddNew
                .Fields("Line").Value = a(i, 1)
                .Fields("Station").Value = a(i, 2)
                .Update
            [COLOR="Navy"]End[/COLOR] [COLOR="Navy"]If[/COLOR]
        [COLOR="Navy"]Next[/COLOR] i
    [COLOR="Navy"]End[/COLOR] [COLOR="Navy"]With[/COLOR]
    
    [COLOR="SeaGreen"]'---------------------------------------------------------------------------------[/COLOR]
    [COLOR="SeaGreen"]'//Process Recordset:[/COLOR]
    [COLOR="SeaGreen"]'  1) Iterate Lines[/COLOR]
    [COLOR="SeaGreen"]'  2) get Min and Max for each Line[/COLOR]
    [COLOR="SeaGreen"]'  3) use rs.Filter to check for existence of Stations from first to last in order[/COLOR]
    [COLOR="SeaGreen"]'  4) repeat for each Line[/COLOR]
    
    resultsCount = 1
    b = Lines.Keys
    
    [COLOR="Navy"]With[/COLOR] rs
        [COLOR="Navy"]For[/COLOR] i = 0 [COLOR="Navy"]To[/COLOR] UBound(b)
            .Filter = "Line=" & Lines.Item(b(i))
            .Sort = "Line,Station"
            [COLOR="Navy"]If[/COLOR] [COLOR="Navy"]Not[/COLOR] .EOF [COLOR="Navy"]Then[/COLOR]
                .MoveLast
                myMax = .Fields(1).Value
                .MoveFirst
                myMin = .Fields(1).Value
                [COLOR="Navy"]For[/COLOR] j = myMin [COLOR="Navy"]To[/COLOR] myMax
                    .Filter = "Line=" & Lines.Item(b(i)) & " AND Station=" & j
                    [COLOR="Navy"]If[/COLOR] .EOF [COLOR="Navy"]Then[/COLOR]
                        [COLOR="Navy"]ReDim[/COLOR] [COLOR="Navy"]Preserve[/COLOR] results(1 [COLOR="Navy"]To[/COLOR] 4, 1 [COLOR="Navy"]To[/COLOR] resultsCount)
                        results(1, resultsCount) = Lines.Item(b(i))
                        results(2, resultsCount) = myMin
                        results(3, resultsCount) = myMax
                        results(4, resultsCount) = j
                        resultsCount = resultsCount + 1
                    [COLOR="Navy"]End[/COLOR] [COLOR="Navy"]If[/COLOR]
                [COLOR="Navy"]Next[/COLOR] j
            [COLOR="Navy"]End[/COLOR] [COLOR="Navy"]If[/COLOR]
        [COLOR="Navy"]Next[/COLOR] i
        
        [COLOR="SeaGreen"]'//If any missing stations were found, output results[/COLOR]
        [COLOR="Navy"]If[/COLOR] resultsCount > 1 [COLOR="Navy"]Then[/COLOR]
            [COLOR="Navy"]Call[/COLOR] OutputResult(results)
        [COLOR="Navy"]Else[/COLOR]
            MsgBox "No missing stations were found. "
        [COLOR="Navy"]End[/COLOR] [COLOR="Navy"]If[/COLOR]
    
    [COLOR="Navy"]End[/COLOR] [COLOR="Navy"]With[/COLOR]
    rs.Close


[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

[COLOR="Navy"]Sub[/COLOR] OutputResult(ByRef arg())
[COLOR="SeaGreen"]'Dim arrTemp()[/COLOR]
[COLOR="SeaGreen"]'Dim i As Long[/COLOR]
[COLOR="SeaGreen"]'Dim j As Long[/COLOR]
[COLOR="Navy"]Dim[/COLOR] wb [COLOR="Navy"]As[/COLOR] Workbook
    
    [COLOR="Navy"]Set[/COLOR] wb = ActiveWorkbook
    wb.Worksheets(1).Range("D1:G1").Value = Array("Line", "Lower", "Upper", "Missing")
    wb.Worksheets(1).Range("D2").Resize(UBound(arg, 2), UBound(arg, 1)).Value = Application.Transpose(arg)
    wb.Worksheets(1).Range("D1:G1").EntireColumn.AutoFit
    wb.Saved = True

[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

[COLOR="Navy"]Sub[/COLOR] TestWorkbooks()
[COLOR="Navy"]Dim[/COLOR] wb [COLOR="Navy"]As[/COLOR] Workbook
[COLOR="Navy"]Dim[/COLOR] intCount [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="Navy"]Dim[/COLOR] a(), b
[COLOR="Navy"]Dim[/COLOR] i [COLOR="Navy"]As[/COLOR] Long, j [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]

    [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] wb [COLOR="Navy"]In[/COLOR] Workbooks
        [COLOR="Navy"]If[/COLOR] Left(wb.Name, 4) = "Book" [COLOR="Navy"]Then[/COLOR]
            wb.Close False
        [COLOR="Navy"]End[/COLOR] [COLOR="Navy"]If[/COLOR]
    [COLOR="Navy"]Next[/COLOR] wb
    
    [COLOR="Navy"]Set[/COLOR] wb = Workbooks.Add
    
    [COLOR="Navy"]With[/COLOR] wb.Worksheets(1)
    
        .Cells(1, 1) = "Line"
        .Cells(1, 2) = "Station"
        .Cells(2, 1) = -1
        .Cells(2, 2) = -1
        .Cells(3, 1) = -1
        .Cells(3, 2) = -1
    
        [COLOR="SeaGreen"]'//Four lines for testing[/COLOR]
        b = Array(1000, 1003, 1006, 1009)
        [COLOR="Navy"]For[/COLOR] i = 0 [COLOR="Navy"]To[/COLOR] UBound(b)
            j = 0
            [COLOR="SeaGreen"]'//random stations, some missing[/COLOR]
            [COLOR="Navy"]Do[/COLOR] [COLOR="Navy"]While[/COLOR] j <= 100
                j = j + 1
                [COLOR="Navy"]If[/COLOR] Rnd > 0.1 [COLOR="Navy"]Then[/COLOR]
                    intCount = intCount + 1
                    [COLOR="Navy"]ReDim[/COLOR] [COLOR="Navy"]Preserve[/COLOR] a(1 [COLOR="Navy"]To[/COLOR] 2, 1 [COLOR="Navy"]To[/COLOR] intCount)
                    a(1, intCount) = b(i)
                    a(2, intCount) = j + 5000
                    [COLOR="Navy"]If[/COLOR] Rnd > 0.9 [COLOR="Navy"]And[/COLOR] j > 50 [COLOR="Navy"]Then[/COLOR]
                        [COLOR="Navy"]Exit[/COLOR] [COLOR="Navy"]Do[/COLOR]
                    [COLOR="Navy"]End[/COLOR] [COLOR="Navy"]If[/COLOR]
                [COLOR="Navy"]ElseIf[/COLOR] Rnd > 0.666 [COLOR="Navy"]Then[/COLOR]
                    [COLOR="Navy"]Do[/COLOR] [COLOR="Navy"]While[/COLOR] Rnd > 0.666
                        j = j + 1
                    [COLOR="Navy"]Loop[/COLOR]
                [COLOR="Navy"]End[/COLOR] [COLOR="Navy"]If[/COLOR]
            [COLOR="Navy"]Loop[/COLOR]
        [COLOR="Navy"]Next[/COLOR] i
        [COLOR="SeaGreen"]'//Write test data to workbook[/COLOR]
        .Cells(Rows.Count, 1).End(xlUp).Offset(1).Resize(UBound(a, 2), 2).Value = Application.Transpose(a)
    
    [COLOR="Navy"]End[/COLOR] [COLOR="Navy"]With[/COLOR]
        
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]
 
Last edited:
Upvote 0
xenou said:
This is my attempt - I tried to minimize the use of iteration (loops) although it's still the basic strategy. Seems to work so far but of course it needs to be tested thoroughly under more realistic conditions. What I did here was create a basic algorithm to find the missing stations - the code creates its own test data so that you can run it as is to demonstrate the results.

For convenience, you can just download a test workbook if you wish:
Sample Workbook
sha256 checksum (zip file): 996dcf4c745896c25d4792473efab5cf55f5ec7377ed2eb481d6fd8e891c459f

Code: 
[COLOR=Navy]Option Explicit[/COLOR]

[COLOR=Navy]Sub[/COLOR] Foo()

[COLOR=Navy]Dim[/COLOR] Lines [COLOR=Navy]As[/COLOR] [COLOR=Navy]Object[/COLOR] [COLOR=SeaGreen]'//Scripting.Dictionary[/COLOR]
[COLOR=Navy]Dim[/COLOR] rs [COLOR=Navy]As[/COLOR] [COLOR=Navy]Object[/COLOR] [COLOR=SeaGreen]'//ADODB.Recordset[/COLOR]
[COLOR=Navy]Dim[/COLOR] rDat [COLOR=Navy]As[/COLOR] Range
[COLOR=Navy]Dim[/COLOR] thisLine [COLOR=Navy]As[/COLOR] [COLOR=Navy]Long[/COLOR]
[COLOR=Navy]Dim[/COLOR] i [COLOR=Navy]As[/COLOR] Long, j [COLOR=Navy]As[/COLOR] [COLOR=Navy]Long[/COLOR]
[COLOR=Navy]Dim[/COLOR] a, b
[COLOR=Navy]Dim[/COLOR] myMin [COLOR=Navy]As[/COLOR] [COLOR=Navy]Long[/COLOR]
[COLOR=Navy]Dim[/COLOR] myMax [COLOR=Navy]As[/COLOR] [COLOR=Navy]Long[/COLOR]
[COLOR=Navy]Dim[/COLOR] results()
[COLOR=Navy]Dim[/COLOR] resultsCount [COLOR=Navy]As[/COLOR] [COLOR=Navy]Long[/COLOR]
[COLOR=Navy]Dim[/COLOR] wb [COLOR=Navy]As[/COLOR] Workbook
    
[COLOR=SeaGreen]'Given two sets of numbers, where column 1 is "Lines" and Column 2 is "Stations",[/COLOR]
[COLOR=SeaGreen]'to seek for missing stations within each Line.[/COLOR]
[COLOR=SeaGreen]'Ex:[/COLOR]
[COLOR=SeaGreen]' 1000 1[/COLOR]
[COLOR=SeaGreen]' 1000 2[/COLOR]
[COLOR=SeaGreen]' 1000 4[/COLOR]
[COLOR=SeaGreen]' 1000 5[/COLOR]
[COLOR=SeaGreen]'Return would be:[/COLOR]
[COLOR=SeaGreen]' 1000 3[/COLOR]
[COLOR=SeaGreen]'Since this is the missing station.[/COLOR]

[COLOR=SeaGreen]'Notes:[/COLOR]
[COLOR=SeaGreen]'Result set includes the first and last station for each line[/COLOR]
[COLOR=SeaGreen]'It is assumed that all stations and lines are Numeric values (Integers)[/COLOR]
[COLOR=SeaGreen]'Any stations with value of -1 are ignored[/COLOR]
[COLOR=SeaGreen]'This is an iterative process so it is not intended for large data sets[/COLOR]
[COLOR=SeaGreen]' (i.e., hundreds of thousands of records)[/COLOR]
    
[COLOR=SeaGreen]'--------------------------------------------------------------------------------[/COLOR]
    
    [COLOR=Navy]Call[/COLOR] TestWorkbooks [COLOR=SeaGreen]'//Use while testing - creates a test data set[/COLOR]
    
    [COLOR=Navy]Set[/COLOR] wb = ActiveWorkbook
    
    [COLOR=SeaGreen]'//Get Data from Cells[/COLOR]
    [COLOR=Navy]Set[/COLOR] rDat = wb.Sheets(1).Cells(1, 1).CurrentRegion
    [COLOR=Navy]If[/COLOR] [COLOR=Navy]Not[/COLOR] IsNumeric(rDat.Cells(1).Value) [COLOR=Navy]Then[/COLOR] [COLOR=SeaGreen]'//Exclude Headers[/COLOR]
        [COLOR=Navy]Set[/COLOR] rDat = rDat.Offset(1).Resize(rDat.Rows.Count - 1, rDat.Columns.Count)
    [COLOR=Navy]End[/COLOR] [COLOR=Navy]If[/COLOR]
    a = rDat.Value
    
    [COLOR=SeaGreen]'//Pull Distinct Line Numbers[/COLOR]
    [COLOR=Navy]Set[/COLOR] Lines = CreateObject("Scripting.Dictionary")
    [COLOR=Navy]For[/COLOR] i = LBound(a, 1) [COLOR=Navy]To[/COLOR] UBound(a, 1)
        [COLOR=Navy]If[/COLOR] [COLOR=Navy]Not[/COLOR] Lines.Exists(CStr(a(i, 1))) [COLOR=Navy]Then[/COLOR]
            Lines.Add CStr(a(i, 1)), CLng(a(i, 1))
        [COLOR=Navy]End[/COLOR] [COLOR=Navy]If[/COLOR]
    [COLOR=Navy]Next[/COLOR] i
    
    [COLOR=SeaGreen]'//Populate Recordset with Dataset (Lines and Stations)[/COLOR]
    [COLOR=SeaGreen]'//   ~~ Exclude rows with -1 as station number[/COLOR]
    [COLOR=Navy]Set[/COLOR] rs = CreateObject("ADODB.Recordset")
    [COLOR=Navy]With[/COLOR] rs
        .Fields.Append "Line", 3 [COLOR=SeaGreen]'adInteger[/COLOR]
        .Fields.Append "Station", 3
        .Open
        thisLine = -999999
        [COLOR=Navy]For[/COLOR] i = 1 [COLOR=Navy]To[/COLOR] UBound(a, 1)
            [COLOR=Navy]If[/COLOR] a(i, 2) <> -1 [COLOR=Navy]Then[/COLOR]
                .AddNew
                .Fields("Line").Value = a(i, 1)
                .Fields("Station").Value = a(i, 2)
                .Update
            [COLOR=Navy]End[/COLOR] [COLOR=Navy]If[/COLOR]
        [COLOR=Navy]Next[/COLOR] i
    [COLOR=Navy]End[/COLOR] [COLOR=Navy]With[/COLOR]
    
    [COLOR=SeaGreen]'---------------------------------------------------------------------------------[/COLOR]
    [COLOR=SeaGreen]'//Process Recordset:[/COLOR]
    [COLOR=SeaGreen]'  1) Iterate Lines[/COLOR]
    [COLOR=SeaGreen]'  2) get Min and Max for each Line[/COLOR]
    [COLOR=SeaGreen]'  3) use rs.Filter to check for existence of Stations from first to last in order[/COLOR]
    [COLOR=SeaGreen]'  4) repeat for each Line[/COLOR]
    
    resultsCount = 1
    b = Lines.Keys
    
    [COLOR=Navy]With[/COLOR] rs
        [COLOR=Navy]For[/COLOR] i = 0 [COLOR=Navy]To[/COLOR] UBound(b)
            .Filter = "Line=" & Lines.Item(b(i))
            .Sort = "Line,Station"
            [COLOR=Navy]If[/COLOR] [COLOR=Navy]Not[/COLOR] .EOF [COLOR=Navy]Then[/COLOR]
                .MoveLast
                myMax = .Fields(1).Value
                .MoveFirst
                myMin = .Fields(1).Value
                [COLOR=Navy]For[/COLOR] j = myMin [COLOR=Navy]To[/COLOR] myMax
                    .Filter = "Line=" & Lines.Item(b(i)) & " AND Station=" & j
                    [COLOR=Navy]If[/COLOR] .EOF [COLOR=Navy]Then[/COLOR]
                        [COLOR=Navy]ReDim[/COLOR] [COLOR=Navy]Preserve[/COLOR] results(1 [COLOR=Navy]To[/COLOR] 4, 1 [COLOR=Navy]To[/COLOR] resultsCount)
                        results(1, resultsCount) = Lines.Item(b(i))
                        results(2, resultsCount) = myMin
                        results(3, resultsCount) = myMax
                        results(4, resultsCount) = j
                        resultsCount = resultsCount + 1
                    [COLOR=Navy]End[/COLOR] [COLOR=Navy]If[/COLOR]
                [COLOR=Navy]Next[/COLOR] j
            [COLOR=Navy]End[/COLOR] [COLOR=Navy]If[/COLOR]
        [COLOR=Navy]Next[/COLOR] i
        
        [COLOR=SeaGreen]'//If any missing stations were found, output results[/COLOR]
        [COLOR=Navy]If[/COLOR] resultsCount > 1 [COLOR=Navy]Then[/COLOR]
            [COLOR=Navy]Call[/COLOR] OutputResult(results)
        [COLOR=Navy]Else[/COLOR]
            MsgBox "No missing stations were found. "
        [COLOR=Navy]End[/COLOR] [COLOR=Navy]If[/COLOR]
    
    [COLOR=Navy]End[/COLOR] [COLOR=Navy]With[/COLOR]
    rs.Close


[COLOR=Navy]End[/COLOR] [COLOR=Navy]Sub[/COLOR]

[COLOR=Navy]Sub[/COLOR] OutputResult(ByRef arg())
[COLOR=SeaGreen]'Dim arrTemp()[/COLOR]
[COLOR=SeaGreen]'Dim i As Long[/COLOR]
[COLOR=SeaGreen]'Dim j As Long[/COLOR]
[COLOR=Navy]Dim[/COLOR] wb [COLOR=Navy]As[/COLOR] Workbook
    
    [COLOR=Navy]Set[/COLOR] wb = ActiveWorkbook
    wb.Worksheets(1).Range("D1:G1").Value = Array("Line", "Lower", "Upper", "Missing")
    wb.Worksheets(1).Range("D2").Resize(UBound(arg, 2), UBound(arg, 1)).Value = Application.Transpose(arg)
    wb.Worksheets(1).Range("D1:G1").EntireColumn.AutoFit
    wb.Saved = True

[COLOR=Navy]End[/COLOR] [COLOR=Navy]Sub[/COLOR]

[COLOR=Navy]Sub[/COLOR] TestWorkbooks()
[COLOR=Navy]Dim[/COLOR] wb [COLOR=Navy]As[/COLOR] Workbook
[COLOR=Navy]Dim[/COLOR] intCount [COLOR=Navy]As[/COLOR] [COLOR=Navy]Long[/COLOR]
[COLOR=Navy]Dim[/COLOR] a(), b
[COLOR=Navy]Dim[/COLOR] i [COLOR=Navy]As[/COLOR] Long, j [COLOR=Navy]As[/COLOR] [COLOR=Navy]Long[/COLOR]

    [COLOR=Navy]For[/COLOR] [COLOR=Navy]Each[/COLOR] wb [COLOR=Navy]In[/COLOR] Workbooks
        [COLOR=Navy]If[/COLOR] Left(wb.Name, 4) = "Book" [COLOR=Navy]Then[/COLOR]
            wb.Close False
        [COLOR=Navy]End[/COLOR] [COLOR=Navy]If[/COLOR]
    [COLOR=Navy]Next[/COLOR] wb
    
    [COLOR=Navy]Set[/COLOR] wb = Workbooks.Add
    
    [COLOR=Navy]With[/COLOR] wb.Worksheets(1)
    
        .Cells(1, 1) = "Line"
        .Cells(1, 2) = "Station"
        .Cells(2, 1) = -1
        .Cells(2, 2) = -1
        .Cells(3, 1) = -1
        .Cells(3, 2) = -1
    
        [COLOR=SeaGreen]'//Four lines for testing[/COLOR]
        b = Array(1000, 1003, 1006, 1009)
        [COLOR=Navy]For[/COLOR] i = 0 [COLOR=Navy]To[/COLOR] UBound(b)
            j = 0
            [COLOR=SeaGreen]'//random stations, some missing[/COLOR]
            [COLOR=Navy]Do[/COLOR] [COLOR=Navy]While[/COLOR] j <= 100
                j = j + 1
                [COLOR=Navy]If[/COLOR] Rnd > 0.1 [COLOR=Navy]Then[/COLOR]
                    intCount = intCount + 1
                    [COLOR=Navy]ReDim[/COLOR] [COLOR=Navy]Preserve[/COLOR] a(1 [COLOR=Navy]To[/COLOR] 2, 1 [COLOR=Navy]To[/COLOR] intCount)
                    a(1, intCount) = b(i)
                    a(2, intCount) = j + 5000
                    [COLOR=Navy]If[/COLOR] Rnd > 0.9 [COLOR=Navy]And[/COLOR] j > 50 [COLOR=Navy]Then[/COLOR]
                        [COLOR=Navy]Exit[/COLOR] [COLOR=Navy]Do[/COLOR]
                    [COLOR=Navy]End[/COLOR] [COLOR=Navy]If[/COLOR]
                [COLOR=Navy]ElseIf[/COLOR] Rnd > 0.666 [COLOR=Navy]Then[/COLOR]
                    [COLOR=Navy]Do[/COLOR] [COLOR=Navy]While[/COLOR] Rnd > 0.666
                        j = j + 1
                    [COLOR=Navy]Loop[/COLOR]
                [COLOR=Navy]End[/COLOR] [COLOR=Navy]If[/COLOR]
            [COLOR=Navy]Loop[/COLOR]
        [COLOR=Navy]Next[/COLOR] i
        [COLOR=SeaGreen]'//Write test data to workbook[/COLOR]
        .Cells(Rows.Count, 1).End(xlUp).Offset(1).Resize(UBound(a, 2), 2).Value = Application.Transpose(a)
    
    [COLOR=Navy]End[/COLOR] [COLOR=Navy]With[/COLOR]
        
[COLOR=Navy]End[/COLOR] [COLOR=Navy]Sub[/COLOR]
Click to expand...

Hi Xenou,

Thanks for taking time to write the codes for me. Yes, this is what I wanted. I am just a newbie and I still have a lot of things to learn. Could you please give your email so I could attached a sample data? Please forward your email to ilak1008@yahoo.com. Cheers.
 
Upvote 0
You must log in or register to reply here.

Similar threads

D
  • Solved
VBA Function to Paste Table into Outlook Email Resulting in HTML language in Email
Replies
8
Views
624
smozgur
smozgur
E
  • Question Question
VBA code clean up
Replies
9
Views
583
mumps
mumps
A
  • Question Question
VBA - Automatically Break the Line in HTML format.
Replies
7
Views
2K
Attrazion
A
E
  • Question Question
VBA for Web Scraping help
Replies
0
Views
921
epactheactor
E
V
  • Question Question
Issue with scraping with VBA
Replies
1
Views
693
John_w
J

Forum statistics

Threads
1,224,609
Messages
6,179,879
Members
452,948
Latest member
Dupuhini

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top