Sequential Checker Macro

Status
This thread has been Locked and is not open to further replies. Please start a New Thread if you're having a similar issue. View our Welcome Guide to learn how to use this site.

marcusmark

Thread Starter
Joined
Nov 30, 2011
Messages
5
Hi,
Would like to seek for help regarding excel macro that I am using.
This code is for development and needs some editing but I was not much familiar with the codes used as I only know more on recording scripts.

Code:
Sub test()
    Dim a, i As Long, temp, x, result
    a = Range("a1").CurrentRegion.Value
    ReDim Preserve a(1 To UBound(a, 1), 1 To 5)
    For i = 1 To UBound(a, 1)
        temp = CheckPattern(a(i, 1))
        x = Split(temp, "|")
        If UBound(x) = 1 Then
            a(i, 2) = x(0)
            a(i, 3) = x(1)
            a(i, 5) = a(i, 1)
        Else
            a(i, 2) = x(0)
            a(i, 3) = x(1)
            a(i, 4) = x(2)
            a(i, 5) = x(0) & x(1)
        End If
    Next
    x = GetGrouped(a)
    x = GetSeries(x(0), x(1), 100)
    result = GetAligned(a, x)
    Application.ScreenUpdating = False
    For i = 1 To UBound(result, 1)
        If result(i, 1) = "" Then Rows(i).Insert
    Next
    Range("a1").Resize(UBound(result, 1), 2).Value = result
    Application.ScreenUpdating = True
End Sub
 
 
Private Function CheckPattern(ByVal txt As String) As String
    Dim Fnum, Lnum
    With CreateObject("VBScript.RegExp")
        .Pattern = "^(\D+)(\d+)$"
        .IgnoreCase = True
        If .test(txt) Then
            CheckPattern = .Replace(txt, "$1|$2")
        Else
            .Pattern = "^(\D+)(\d+) ?\-(.*\D)?(\d+)$"
            If .test(txt) Then
                Fnum = .Replace(txt, "$2")
                Lnum = .Replace(txt, "$4")
                If Len(Fnum) <> Len(Lnum) Then
                    Lnum = Application.Replace(Fnum _
                    , Len(Fnum) - Len(Lnum) + 1, Len(Fnum), Lnum)
                End If
                CheckPattern = .Replace(txt, "$1|") & Fnum & "|" & Lnum
            Else
                .Pattern = "^(\D+)(\d+) DEN (\d+) .*$"
                If .test(txt) Then
                    Fnum = .Replace(txt, "$2")
                    Lnum = .Replace(txt, "$3")
                    If Len(Fnum) <> Len(Lnum) Then
                        Lnum = Application.Replace(Fnum _
                        , Len(Fnum) - Len(Lnum) + 1, Len(Fnum), Lnum)
                    End If
                    CheckPattern = .Replace(txt, "$1|") & Fnum & "|" & Lnum
                End If
            End If
        End If
    End With
End Function
 
 
Private Function GetGrouped(a As Variant) As Variant
    Dim i As Long, w(), myNum
    With CreateObject("Scripting.Dictionary")
        .comparemode = 1
        For i = 1 To UBound(a, 1)
            If Not .exists(a(i, 2)) Then
                ReDim w(1 To 4, 1 To 1)
                w(1, 1) = a(i, 3)
                w(2, 1) = IIf(a(i, 4) = "", a(i, 3), a(i, 4))
                w(3, 1) = a(i, 3)
                .Item(a(i, 2)) = w
            Else
                w = .Item(a(i, 2))
                ReDim Preserve w(1 To 4, 1 To UBound(w, 2) + 1)
                w(1, UBound(w, 2)) = a(i, 3)
                w(2, UBound(w, 2)) = IIf(a(i, 4) = "", a(i, 3), a(i, 4))
                w(3, UBound(w, 2)) = _
                w(2, UBound(w, 2)) - Val(w(1, UBound(w, 2) - 1))
                .Item(a(i, 2)) = w
            End If
        Next
        GetGrouped = VBA.Array(.keys, .items)
    End With
End Function
 
 
Function GetSeries(x, y, myLimit)
    Dim i As Long, ii As Long, iii As Long
    With CreateObject("System.Collections.ArrayList")
        For i = LBound(x) To UBound(x)
            If UBound(y(i), 2) = 1 Then
                For iii = y(i)(1, 1) To y(i)(2, 1)
                    .Add x(i) & iii
                Next
            Else
                .Add x(i) & y(i)(1, 1)
                For ii = 2 To UBound(y(i), 2)
                    If y(i)(2, ii) > y(i)(2, ii - 1) And y(i)(3, ii) < myLimit Then
                        For iii = y(i)(2, ii - 1) + 1 To y(i)(2, ii)
                            .Add x(i) & iii
                        Next
                    Else
                        .Add x(i) & y(i)(1, ii)
                    End If
                Next
            End If
        Next
        GetSeries = .ToArray
    End With
End Function
 
 
Function GetAligned(p, x)
    Dim i As Long, temp
    ReDim a(1 To UBound(x) + 1, 1 To 2)
    With CreateObject("Scripting.Dictionary")
        For i = 0 To UBound(x)
            .Item(x(i)) = i + 1
            a(i + 1, 2) = x(i)
        Next
        For i = 1 To UBound(p, 1)
            temp = p(i, 2) & p(i, 3)
            If .exists(temp) Then a(.Item(temp), 1) = p(i, 1)
        Next
        GetAligned = a
    End With
End Function
Data that can be used as sample are:
Cell A1 - ES10001
Cell A2 - ES10002
Cell A3 - ES10003
Cell A4 - ES10004-ES10006
Cell A5 - ES10007 - 08 - 09 - 10
Cell A6 - ES10011
Cell A7 - DCY10001 DEN 90 E KADAR
Cell A8 - DT40000

For the samples above, Cell A1-A6 are in a sequence, and just like in the code above, Cell A4 and Cell A5 would be seperated by inserting another rows and putting the values in order. Cell A4 means ES10004, ES10005 & ES10006. Cell A5 means ES10007-ES10010.
Cell A7 is same scenario. That kind of format means DCY10001 to DCY10090 (DCY10001 DEN 90 E KADAR or DCY10001 till 90).
In Cell A8, there is no succeeding sequence. This is an error that must be detected by macro code, making the counter value in Cell B8 with text as "out of order". In simple words, when a value is not in sequence, it is automatically an error


1. Need help o label this codes for me to understand how it works
2. The codes are not detecting those inserted values. Like if in the sequence of ES10001-04 then ES10006, you add ES10005 to the sequence. Would like the macro to mark this one as added/inserted values like writing in the column C the text "added values".
3. Would like to know how to disable # 2 (macro would not insert missing values). Guess it would be solved when codes are labelled.
4. Need to have another code when there are values with no sequence. Like in Cell A8, DT40000, there are no more sequence following it.

Many thanks in advance!

P.S. Have post it also in below link though still no reply:
http://www.excelforum.com/forum-rules/642590-forum-rules.html
 

Keebellah

Hans
Trusted Advisor
Joined
Mar 27, 2008
Messages
6,641
Hi, welcome to the board, looks like an interesting challenge, I've downloaded the code and pasted it into a sheet and will see if I understand what you're asking.
I'll get back to you.
 

marcusmark

Thread Starter
Joined
Nov 30, 2011
Messages
5
Wow. Many thanks Keebellah for your attention.
=)
Hoping to hear from you.
Thanks again!
 

Keebellah

Hans
Trusted Advisor
Joined
Mar 27, 2008
Messages
6,641
Don't party too soon, Í'm working out the code you use but with a little time...
I hope that I can find a solution for you
 

marcusmark

Thread Starter
Joined
Nov 30, 2011
Messages
5
Hi Keebellah,
Its ok, atleast I know there is someone attending my query. =D
I'll also tell how it works without a macro or the summary of this macro.

There are series of orders that needs to be identified.
The only consistent one is that a value will always start with an Alpha character (ES, D, DCY, etc) then a Numeric character (10001, 100, 5000000, etc).
One will know if it is part of a sequence when it is in +100 ruling. I mean that the numeric characters are not apart with each other by 100 like ES100004 then ES100080 since 100080 is less than 100 difference with 100004. So if the last value is ES100004-ES100080 then ES200000, then ES200000 means to be another set of sequence since the numeric character is out of +100 rule range.
There are different style of sequence but limited to below:
ES100001
ES100002
ES100003; or
ES100001-03; or
ES100001-02-03; or
ES100001-ES100003; or
ES100001 DEN 03 E KADAR which means ES100001 until 03 in English

Spaces should be ignored by macro tool like:
ES100001-03 or ES100001 -03 or ES100001- 03 or ES100001 - 03..All are just the same.

These are the query above that needs to be added to the codes if not change:

If a value is not part of any sequence like:
ES100001 then
ES100002 then
ES500000
ES100001 and ES100002 are in sequence while ES50000 does not belong to any sequence.
The macro should write a text value that says "No sequence"

There are also values like ES10000-ES10008-MC10000..The macro will write "Unknown sequence"

And lastly, the macro is adding value to missing sequence like:
ES10001 then ES10002 then ES10004...Macro adds the value ES10003 to fill the missing sequence by inserting rows. Macro should write "Added Value" for it to be identified.

Many thanks!
 

Keebellah

Hans
Trusted Advisor
Joined
Mar 27, 2008
Messages
6,641
Thanks, you cleared up some things for me, I had worked out some of these but was still figuring it out.
It's difficult to 'see' inside someone's head :)
 

Keebellah

Hans
Trusted Advisor
Joined
Mar 27, 2008
Messages
6,641
I've been trying to figure out the different arrays you have used.
I haven't figured it all out yet but I think an extra dimension should be added during the GetGrouped() pocedure
Here you can test if there is sequence or not and put the value which then can be displayed in column C.

Like I said, I'm looking at what it all does, no solution yet.
 

marcusmark

Thread Starter
Joined
Nov 30, 2011
Messages
5
hmmm..
Actually, my knowledge in macro is only the basics and recordings.
I'm confused with this private function, getgrouped codes
=(
 

Keebellah

Hans
Trusted Advisor
Joined
Mar 27, 2008
Messages
6,641
A private function is only allowe with that module, cobtrary to public or no mention
 

Keebellah

Hans
Trusted Advisor
Joined
Mar 27, 2008
Messages
6,641
I haven't booked much win but I did try something which is not yet correct.
I am still figuring out where I could expand the array to add the values.

The macro now adds the messag Added Value but this is not true in all cases.
Still working on it.
Good-night for now.
 

Attachments

Keebellah

Hans
Trusted Advisor
Joined
Mar 27, 2008
Messages
6,641
It's not all ready yet but I got something.
The sequential values that are tru I have not yet figured out.

Run the macro testTSG and check Sheet3
 

Attachments

Keebellah

Hans
Trusted Advisor
Joined
Mar 27, 2008
Messages
6,641
Update:

Got a little more done
ES10007 - 08 - 09 - 10 is the one that I haven't solved, it will show added value but that is not rue.
Th no squence or out of sequence seems to work
I removed ES10002
and added an XX99999 to show
 

Attachments

marcusmark

Thread Starter
Joined
Nov 30, 2011
Messages
5
hi Keebellah,
Many thanks for your works.=D
Sorry I was on emergency work-related travel.
Have just came back again.
Have tried the last attachment.
For the first one, ES100003 was mark as "out of sequence" though it is on sequence with ES100001. For the "added value" remarks, it seems that its not true in every cases...like in ES10007-08-09-10.. Then in ES10004-ES10006, ES10006 is also an added value...so the main row only is for the ES10004 without remarks..=)
 

Keebellah

Hans
Trusted Advisor
Joined
Mar 27, 2008
Messages
6,641
I removed ES100002 as a test and thought that would mean out of sequence.
The blanks are the first and last of that array
ES10006 is in the array as last of that block
 
Status
This thread has been Locked and is not open to further replies. Please start a New Thread if you're having a similar issue. View our Welcome Guide to learn how to use this site.

Users Who Are Viewing This Thread (Users: 0, Guests: 1)

As Seen On
As Seen On...

Welcome to Tech Support Guy!

Are you looking for the solution to your computer problem? Join our site today to ask your question. This site is completely free -- paid for by advertisers and donations.

If you're not already familiar with forums, watch our Welcome Guide to get started.

Join over 807,865 other people just like you!

Latest posts

Staff online

Members online

Top