Help in Array

Re: Help in Array

Thank you , how do you want me to send it?

Re: Help in Array

The end result before/after is the same , i.e the desks will be distributed based on the code , the current VBA code is looking at the column D , I want it to look at column H when it distributes the data to the desks.

I need to send you the XL file, if you like I can email it to you if no bother.

Re: Help in Array

The test VBA code is :

Sub test()
    Dim a, e, w(), i As Long, txt As String, x As Range
    Dim dic As Object, RegX As Object
    Set dic = CreateObject("Scripting.Dictionary")
    dic.CompareMode = 1
    Set RegX = CreateObject("VBScript.RegExp")
    RegX.Pattern = "\D+([2-9]\d{1,2}|[12]\d{3}|90\d{2})(?=$)"
    For Each e In Array(VBA.Array("$AS", "Desk1"), VBA.Array("$AI", "Desk2"), _
        VBA.Array("$AK", "Desk3"), VBA.Array("$AN", "Desk4"), _
        VBA.Array("$AQ", "Desk5"), VBA.Array("$AE", "Desk6"), _
        VBA.Array("$XW", "Desk7"), VBA.Array("$Open", "Open"))
        dic(e(0)) = VBA.Array(e(1), Nothing)
    Next
    With Sheets("SDT file")
        .Activate
        With .Range("a1", .Range("a" & Rows.Count).End(xlUp))
            .Value = Evaluate("if(" & .Address & "<>""""," & .Address & ","""")")
        End With
        .Range("a" & Rows.Count).End(xlUp)(2).EntireRow.Clear
        With .Range("a1").CurrentRegion
            For i = 2 To .Rows.Count
                If UCase$(.Rows(i).Cells(4).Value) = "$OPEN" Then
                    txt = "$Open"
                Else
                    txt = Left$(.Rows(i).Cells(4).Value, 3)
                End If
                If Not RegX.test(.Rows(i).Cells(1).Value) Then
                txt = "N/A"
            End If
                If dic.exists(txt) Then
                    w = dic(txt)
                    If w(1) Is Nothing Then
                        Set w(1) = .Rows(i)
                    Else
                        Set w(1) = Union(w(1), .Rows(i))
                    End If
                    dic(txt) = w
                Else
                    If x Is Nothing Then
                        Set x = .Rows(i)
                    Else
                        Set x = Union(x, .Rows(i))
                    End If
                End If
            Next
        End With
    End With
    For Each e In dic.keys
        w = dic(e)
        If Not w(1) Is Nothing Then
            w(1).Copy _
            Sheets(w(0)).Range("a" & Rows.Count).End(xlUp)(2)
        End If
    Next
    If Not x Is Nothing Then
        x.Copy Sheets("Desk8").Range("a" & Rows.Count).End(xlUp)(2)
    End If
    Set dic = Nothing
    Set x = Nothing
    Set RegX = Nothing
End Sub

The XL file has desks numbered "Desk1" to "Desk8" and desk called "Open" , the above VBA code when it distributes the data the VBA code looks at column D.

I wish I could send you the file.

Re: Help in Array

And here is 10 rows of data

[TABLE="width: 650"]

SMM104

[TD="align: right"]2055[/TD]
[TD="align: right"]2225[/TD]

$ASQL11

[TD="align: right"]132[/TD]

EEJYA

EER9

311

[TD="align: right"]11008020[/TD]
[TD="align: right"]11008020[/TD]

SNM1056

[TD="align: right"]2200[/TD]
[TD="align: right"]2330[/TD]

$ASXL12

[TD="align: right"]155[/TD]

EEJY9

EER9

32E

[TD="align: right"]11009962[/TD]
[TD="align: right"]11009962[/TD]

SNM865

[TD="align: right"]1035[/TD]
[TD="align: right"]1955[/TD]

$AIVP34

[TD="align: right"]382[/TD]

RYXL

EEDB

700

[TD="align: right"]11009971[/TD]
[TD="align: right"]11009971[/TD]

SNM373

[TD="align: right"]0930[/TD]
[TD="align: right"]1630[/TD]

$AQCJ123

[TD="align: right"]298[/TD]

EEJY1

XMNM

322

[TD="align: right"]11050672[/TD]
[TD="align: right"]11050672[/TD]

SNM1136

[TD="align: right"]0400[/TD]
[TD="align: right"]0500[/TD]

$AEJPV12

[TD="align: right"]65[/TD]

EER9

EEDB

V70

[TD="align: right"]11050689[/TD]
[TD="align: right"]11050689[/TD]

SNM457

[TD="align: right"]0220[/TD]
[TD="align: right"]0515[/TD]

$AINMP

[TD="align: right"]416[/TD]

EER9

H9SS

700

[TD="align: right"]11050728[/TD]
[TD="align: right"]11050728[/TD]

SNM833

[TD="align: right"]0700[/TD]
[TD="align: right"]1450[/TD]

$AK1234

[TD="align: right"]384[/TD]

MKLL6

EER9

713

[TD="align: right"]11050729[/TD]
[TD="align: right"]11050729[/TD]

SNM1052

[TD="align: right"]2000[/TD]
[TD="align: right"]2130[/TD]

$AIMVC8

[TD="align: right"]409[/TD]

EEJY

EER9

700

[TD="align: right"]11050735[/TD]
[TD="align: right"]11050735[/TD]

SNM996

[TD="align: right"]0705[/TD]
[TD="align: right"]1605[/TD]

$ANDW7

[TD="align: right"]0[/TD]

EER9

Z8PD

M1F

[TD="align: right"]11050736[/TD]
[TD="align: right"]11050736[/TD]

SNM838

[TD="align: right"]2315[/TD]
[TD="align: right"]0730[/TD]

$AKOPV

[TD="align: right"]328[/TD]

EER9

WXU81

772

[TD="align: right"]17000106[/TD]
[TD="align: right"]17000106[/TD]

[/TABLE]

Re: Help in Array

Hello ,

The 10 data sample rows are :-

[TABLE="width: 651"]

SN#

I Time

O Time

Reg Code

Ncount

Flocation

Tlocation

Type

1SEQ

New Seq

SMM104

2055

2225

$ASQL11

132

EEJYA

EER9

311

11008020

11008020

SNM1056

2200

2330

$ASXL12

155

EEJY9

EER9

32E

11009962

11009962

SNM865

1035

1955

$AIVP34

382

RYXL

EEDB

700

11009971

11009971

SNM373

0930

1630

$AQCJ123

298

EEJY1

XMNM

322

11050672

11050672

SNM1136

0400

0500

$AEJPV12

65

EER9

EEDB

V70

11050689

11050689

SNM457

0220

0515

$AINMP

416

EER9

H9SS

700

11050728

11050728

SNM833

0700

1450

$AK1234

384

MKLL6

EER9

713

11050729

11050729

SNM1052

2000

2130

$AIMVC8

409

EEJY

EER9

700

11050735

11050735

SNM996

0705

1605

$ANDW7

0

EER9

Z8PD

M1F

11050736

11050736

SNM838

2315

0730

$AKOPV

328

EER9

WXU81

772

17000106

17000106

[/TABLE]

Thank you.

Re: Help in Array

Quote from jindon;758378

I completely forgot what is this all about, so I need to see the file to test.

Hello Jindon,

I was not able to attach the file, is there any way I can send it?

Thank you.