Help in Array

excellover2012 · Oct 5th 2015

Need help please

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

Code

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)

Display More

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.

**StephenR** · Oct 5th 2015

Re: Help in Array

excellover2012 - after 85 posts you should really know about using code tags by now. Don't make one of us have to add them again.

Please post all your code.

jindon · Oct 5th 2015

Re: Help in Array

Post a workbook clearly showing before/after, so that it will be clearer.

excellover2012 · Oct 5th 2015

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.

excellover2012 · Oct 5th 2015

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.

excellover2012 · Oct 5th 2015

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.

**rory** · Oct 5th 2015

Re: Help in Array

Nothing in what you have posted refers to any columns.

excellover2012 · Oct 6th 2015

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

**rory** · Oct 6th 2015

Re: Help in Array

You're missing the point. Nowhere in the code you posted does it refer to any columns, so there's nothing there to change.

jindon · Oct 6th 2015

Re: Help in Array

excellover2012

You are truly hopeless.

You should learn how to ask question first.....

http://www.ozgrid.com/forum/sh…65878&p=610579#post610579

Change 4 to 8

Code

If UCase$(.Rows(i).Cells(8).Value) = "$OPEN" Then 
                    txt = "$Open" 
                Else 
                    txt = Left$(.Rows(i).Cells(8).Value, 3) 
                End If

**rory** · Oct 6th 2015

Re: Help in Array

Also cross-posted here: http://www.mrexcel.com/forum/e…change-array-look-up.html

Please learn the forum rules (at both forums!).

excellover2012 · Oct 11th 2015

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

Code

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

Display More

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.

jindon · Oct 11th 2015

Re: Help in Array

You must follow the forum rule before ask anything.

excellover2012 · Oct 11th 2015

Re: Help in Array

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

Can you help Please?

jindon · Oct 11th 2015

Re: Help in Array

1) You must give us all the link(s) that you posted same question in other forum(s).

2) You must use code tag when you post vba code.

That's all in forum rule.

excellover2012 · Oct 11th 2015

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.

excellover2012 · Oct 11th 2015

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

Code

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

Display More

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.

jindon · Oct 11th 2015

Re: Help in Array

1) You are still missing link(s). This is required.

2) Post a workbook with before/after.

excellover2012 · Oct 16th 2015

Re: Help in Array

You want me to post the whole excel file?

jindon · Oct 16th 2015

Re: Help in Array

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

Help in Array

Participate now!

Share