#### marcusmark

Thread Starter

- Joined
- Nov 30, 2011

- Messages
- 5

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

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