Posts by excellover2012

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.

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

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

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

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

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

Re: Help in Array

You want me to post the whole excel file?

Re: Help in Array

Hello Jindon,

Thank you Again, Here is the current VB code you kindly provided me back then with little adjustment.

Thank you.

May be I did not explain what I really needed in the VB code , but please note that :-

The current VB code is :-

Sub testCopy()
     ActiveSheet.Unprotect "xyz12345"
     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{1,3}|90\d{2})(?=$)"
     For Each e In Array(VBA.Array("$AS", "A100"), VBA.Array("$AI", "NonSkd"), _
         VBA.Array("$AK", "B200"), VBA.Array("$AN", "NonSkd"), _
         VBA.Array("$AQ", "K300"), VBA.Array("$AE", "RA70"), _
         VBA.Array("$XX", "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.Resize(, 10)
             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("NonSkd").Range("a" & Rows.Count).End(xlUp)(2)
     End If
     Set dic = Nothing
     Set x = Nothing
     Set RegX = Nothing
 ActiveSheet.Protect "xyz12345"
    
   End Sub

What I needed was that the code look at column H and place the data to the correspondence desk

e.g: if column H data is 77L it places the whole row information in a desk called "A100" , if column H data is 77X then it places it in a desk called "B100" so forth so on.

A-------B---------- C------- D ------------E---------------F-----------------G--------------H-------I--------------J-------
SN#----ITime-----OTime---Reg Code---NCount--------FLocation--------Tlocation------Type----1SEQ-------New Seq
YYA61--0015------1345----$YYA---------223-----------XXVV-------------XXWW--------77L-----6204825----6204825

your help is really appreciated.

Thank you.

Re: Help in Array

Thank you Jindon,

1) I only posted on these 2 forums , do you want me to copy the links?
2) I will use code tag ( let me try )

Sorry.

Re: Help in Array

I was just trying to get help from other forums, I am sorry.

Can you help Please?

Re: Help in Array

Hello Jindon,

Please accept my apology , i know your were helping me a lot , in fact, the current VB code was done by you back then.

thank you.

May be i did not explain what i really needed in the VB code , but please note that :-

The current VB code is :-

Sub testCopy()
    ActiveSheet.Unprotect "xyz12345"
    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{1,3}|90\d{2})(?=$)"
    For Each e In Array(VBA.Array("$AS", "A100"), VBA.Array("$AI", "NonSkd"), _
        VBA.Array("$AK", "B200"), VBA.Array("$AN", "NonSkd"), _
        VBA.Array("$AQ", "K300"), VBA.Array("$AE", "RA70"), _
        VBA.Array("$XX", "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.Resize(, 10)
            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("NonSkd").Range("a" & Rows.Count).End(xlUp)(2)
    End If
    Set dic = Nothing
    Set x = Nothing
    Set RegX = Nothing
ActiveSheet.Protect "xyz12345"
   
  End Sub

What I needed was that the code look at column H and place the data to the correspondence desk

e.g: if column H data is 77L it places the whole row information in a desk called "A100" , if column H data is 77X then it places it in a desk called "B100" so forth so on.

A-------B---------- C------- D ----------E---------------F-------------- G---------H-------I--------------J-------
SN#----ITime-----OTime---Reg Code---NCount------FLocation------Tlocation------Type----1SEQ-------New Seq
YYA61--0015------1345----$YYA-------223---------XXVV----------XXWW---------77L-----6204825----6204825

your help is really appreciated.

Thank you.

Re: Help in Array

Thank you Appreciated.

The above code looks at the value $YYA in column D under the header "Reg Code", I want it to look at column H under the header "Type".

Re: Help in Array

Understood Stephen, putting the code in a tag , sorry , I forgot how to use the code tags, is it part of the advanced code insertion process ?

Thank you for adding it for me. appreciated.

Re: Help in Array

Thank you Jindon,

The before/after result is the same , the VBA array is currently looking at Column D to store the data in the worksheets "A100","Non", "B200" so forth so on.

What I needed was the array to look at column H to store the data in the above mentioned worksheets.

Thank you for your kind help.

Re: Help in Array

Thank you , sorry Stephen and thank you for your help, but I did use a title to tag my question.
Please help.
Thank you.

Need help please

The below array is looking at column D , how can I change it to look at column H

Sub testCopy()
    ActiveSheet.Unprotect "xyz12345"
    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{1,3}|90\d{2})(?=$)"
    For Each e In Array(VBA.Array("$YY", "A100"), VBA.Array("$YX", "Non"), _
 VBA.Array("$YW", "B200"))
        dic(e(0)) = VBA.Array(e(1), Nothing)

A-------B---------- C------- D ----------E---------------F-------------- G-------------H-------I----------J-------
SN#----ITime-----OTime---Reg Code---NCount------FLocation------Tlocation------Type---1SEQ-------New Seq
YYA61--0015------1345----$YYA--------223----------XXVV-----------XXWW---------77L----6204825---6204825

Thank you for you kind help.

Re: Distributing data to multiple sheets based on 2 criteria

It is working , Thanks.

I noticed when I run the code multiple times it is not clearing the old data in the desks , it adds them , It was supposed to clear the previous data in all desks before copying the new data.

Re: Distributing data to multiple sheets based on 2 criteria

Hello Jindon,

Noticed that the code is selecting the whole range when distributing and copying the data to the desks, the problem with this is that I have data on the other ranges that got copied to the desks which I don't want.

The data that need to be distributed are in the rows A2:J2

Is is possible to only distribute/copy the data available in the range A1:J1 only.

Thanks.

Re: Distributing data to multiple sheets based on 2 criteria

This is promising , I will test it and let you know,

Hey Jindon, I start to doubt whether you are one of our earthly species or a genius machine I am talking to , your prompt answers and tireless reply and help keeps me wondering.

Which every way :smile: , thank you very much.

Re: Distributing data to multiple sheets based on 2 criteria

Hello Jindon,

The run time error was caused by some data issue, I cleared it and did not experience any run time error any more.

When testing the code noticed that:-

In the first rule:-

1) Any Flight# 20 to 2999 and 9000 to 9099 and has any Reg Code as shown in the list 1 - 7 then these Flights to be distributed to the Desks 1 - 7 regardless of the Trip no.

The code is not properly distributing the Flight# range when it is 100 – 199 and Reg Code is part of the 1 – 7 categories.
It is placing these Flight# ranges 100 – 199 in Desk8 instead of distributing them in desks 1 - 7.

Thank you for your continues support and help.