1. Computer problem? Tech Support Guy is completely free -- paid for by advertisers and donations. Click here to join today! If you're new to Tech Support Guy, we highly recommend that you visit our Guide for New Members.

Sequential Checker Macro

Discussion in 'Business Applications' started by marcusmark, Nov 30, 2011.

Thread Status:
Not open for further replies.
Advertisement
  1. marcusmark

    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
     
  2. Keebellah

    Keebellah Trusted Advisor

    Joined:
    Mar 27, 2008
    Messages:
    6,608
    First Name:
    Hans
    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.
     
  3. marcusmark

    marcusmark Thread Starter

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

    Keebellah Trusted Advisor

    Joined:
    Mar 27, 2008
    Messages:
    6,608
    First Name:
    Hans
    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
     
  5. marcusmark

    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!
     
  6. Keebellah

    Keebellah Trusted Advisor

    Joined:
    Mar 27, 2008
    Messages:
    6,608
    First Name:
    Hans
    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 :)
     
  7. Keebellah

    Keebellah Trusted Advisor

    Joined:
    Mar 27, 2008
    Messages:
    6,608
    First Name:
    Hans
    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.
     
  8. marcusmark

    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
    =(
     
  9. Keebellah

    Keebellah Trusted Advisor

    Joined:
    Mar 27, 2008
    Messages:
    6,608
    First Name:
    Hans
    A private function is only allowe with that module, cobtrary to public or no mention
     
  10. Keebellah

    Keebellah Trusted Advisor

    Joined:
    Mar 27, 2008
    Messages:
    6,608
    First Name:
    Hans
    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.
     

    Attached Files:

  11. Keebellah

    Keebellah Trusted Advisor

    Joined:
    Mar 27, 2008
    Messages:
    6,608
    First Name:
    Hans
    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
     

    Attached Files:

  12. Keebellah

    Keebellah Trusted Advisor

    Joined:
    Mar 27, 2008
    Messages:
    6,608
    First Name:
    Hans
    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
     

    Attached Files:

  13. Keebellah

    Keebellah Trusted Advisor

    Joined:
    Mar 27, 2008
    Messages:
    6,608
    First Name:
    Hans
    I think I got it all (I hope)

    I added some comments in the VBA code
     

    Attached Files:

  14. marcusmark

    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..=)
     
  15. Keebellah

    Keebellah Trusted Advisor

    Joined:
    Mar 27, 2008
    Messages:
    6,608
    First Name:
    Hans
    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
     
  16. Sponsor

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 733,556 other people just like you!

Loading...
Similar Threads - Sequential Checker Macro
  1. Minhaz
    Replies:
    1
    Views:
    280
Thread Status:
Not open for further replies.

Short URL to this thread: https://techguy.org/1029039

  1. This site uses cookies to help personalise content, tailor your experience and to keep you logged in if you register.
    By continuing to use this site, you are consenting to our use of cookies.
    Dismiss Notice