# 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

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)
Next
Else
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)
Next
Else
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.

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
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

Wow. Many thanks Keebellah for your attention.
=)
Hoping to hear from you.
Thanks again!

#### Keebellah

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

#### marcusmark

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
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
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

hmmm..
Actually, my knowledge in macro is only the basics and recordings.
I'm confused with this private function, getgrouped codes
=(

#### Keebellah

Hans
A private function is only allowe with that module, cobtrary to public or no mention

#### Keebellah

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.

#### Attachments

• 29.2 KB Views: 29

#### Keebellah

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

#### Attachments

• 32.7 KB Views: 28

#### Keebellah

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

#### Attachments

• 37.4 KB Views: 24

#### Keebellah

Hans
I think I got it all (I hope)

#### Attachments

• 38 KB Views: 49

#### marcusmark

hi Keebellah,
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
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.