Array Validation | [A-Z] Sort + Remove Duplicates

SoniboiTM

New Member
Joined
Jul 25, 2020
Messages
22
Office Version
  1. 2019
Platform
  1. Windows
  2. Web
Problem: Array Manipulation

1. Requirements:

- B4: Keep as it is.

- Data source: from B4 up to first non-empty cells in column B.

- Remove non-security code data (enclosed in parenthesis, e.g., (deposit), (subscribe), (etc.))

- Remove the duplicate

- Array data - sort in ascending order.

- Print output data in D4, D5, etc. depends on how many items are there in array.

2. VBA Coding

VBA Code:
Sub RefreshTSData()
    Dim vMyArray() As Variant
    Dim vNames As Range
    Dim vCell As Variant
    Dim iCtr As Long
   
    Set vNames = Sheets("J2-Trading Journal").Range("A1:A7")   'A7 = last row of non-empty cells

    iCtr = 0
    For Each vCell In vNames
        If Mid(vCell.Value, 1, 1) = "(" Then
            'do not add to array
        Else
            'validate: if duplicate value, do not add to array
            'validate: if unique value, add to array
            iCtr = iCtr + 1
            vMyArray(iCtr) = vCell     'error: out of range
       End If

       'Debug.Print vMyArray(iCtr)

    Next vCell
   
    Range("C1:C5000").Value = vMyArray.Value  'Error
End Sub


3. Need to learn more technique in data manipulations, too. This time, on how to use an array effectively.

Any idea, sirs?
Array.jpg


Thanks in advance for your help.
 
Last edited:

Some videos you may like

Excel Facts

Workdays for a market open Mon, Wed, Friday?
Yes! Use "0101011" for the weekend argument in NETWORKDAYS.INTL or WORKDAY.INTL. The 7 digits start on Monday. 1 means it is a weekend.

Peter_SSs

MrExcel MVP, Moderator
Joined
May 28, 2005
Messages
46,837
Office Version
  1. 365
Platform
  1. Windows
For the future, you will generally get faster responses if you provide your sample data with XL2BB so helpers do not have to manually type out sample data to test with.

Secondly, there seems some confusion between your code and your image about just where your data and results are.

However, this is how I would do it. See if it can help you. I Have assumed that both data and results go on the active sheet.

VBA Code:
Sub Extract_List()
  Dim AL As Object
  Dim aryData As Variant
  Dim i As Long
 
  Set AL = CreateObject("System.Collections.ArrayList")
  aryData = Range("A2", Range("A" & Rows.Count).End(xlUp)).Value
  For i = 1 To UBound(aryData)
    If Left(aryData(i, 1), 1) <> "(" Then
      If Not AL.contains(aryData(i, 1)) Then AL.Add aryData(i, 1)
    End If
  Next i
  AL.Sort
  Range("C2").Resize(AL.Count).Value = Application.Transpose(AL.ToArray)
End Sub

My sample data and results

SoniboiTM 2020-07-31 1.xlsm
ABC
1
2(Deposit)FB
3MEGGLO
4MWIDEMEG
5(Deposit)MWIDE
6GLO
7FB
8(Subscribe)
9MWIDE
10
J2-Trading Journal
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
48,076
Office Version
  1. 365
Platform
  1. Windows
How about
VBA Code:
Sub SoniboiTM()
   Dim Lst As Object
   Dim Cl As Range
  
   Set Lst = CreateObject("system.collections.arraylist")
   With Sheets("J2-Trading Journal")
      For Each Cl In .Range("B4", .Range("B" & Rows.Count).End(xlUp))
         If Left(Cl.Value, 1) <> "(" And Cl.Value <> "" Then
            If Not Lst.Contains(Cl.Value) Then Lst.Add Cl.Value
         End If
      Next Cl
      Lst.Sort
      .Range("D4").Resize(Lst.Count).Value = Application.Transpose(Lst.ToArray)
   End With
End Sub
Beaten 2it
 

SoniboiTM

New Member
Joined
Jul 25, 2020
Messages
22
Office Version
  1. 2019
Platform
  1. Windows
  2. Web
For the future, you will generally get faster responses if you provide your sample data with XL2BB so helpers do not have to manually type out sample data to test with.

Secondly, there seems some confusion between your code and your image about just where your data and results are.

However, this is how I would do it. See if it can help you. I Have assumed that both data and results go on the active sheet.

VBA Code:
Sub Extract_List()
  Dim AL As Object
  Dim aryData As Variant
  Dim i As Long

  Set AL = CreateObject("System.Collections.ArrayList")
  aryData = Range("A2", Range("A" & Rows.Count).End(xlUp)).Value
  For i = 1 To UBound(aryData)
    If Left(aryData(i, 1), 1) <> "(" Then
      If Not AL.contains(aryData(i, 1)) Then AL.Add aryData(i, 1)
    End If
  Next i
  AL.Sort
  Range("C2").Resize(AL.Count).Value = Application.Transpose(AL.ToArray)
End Sub

My sample data and results

SoniboiTM 2020-07-31 1.xlsm
ABC
1
2(Deposit)FB
3MEGGLO
4MWIDEMEG
5(Deposit)MWIDE
6GLO
7FB
8(Subscribe)
9MWIDE
10
J2-Trading Journal


This is great!
and very short code.
 

SoniboiTM

New Member
Joined
Jul 25, 2020
Messages
22
Office Version
  1. 2019
Platform
  1. Windows
  2. Web

ADVERTISEMENT

How about
VBA Code:
Sub SoniboiTM()
   Dim Lst As Object
   Dim Cl As Range
 
   Set Lst = CreateObject("system.collections.arraylist")
   With Sheets("J2-Trading Journal")
      For Each Cl In .Range("B4", .Range("B" & Rows.Count).End(xlUp))
         If Left(Cl.Value, 1) <> "(" And Cl.Value <> "" Then
            If Not Lst.Contains(Cl.Value) Then Lst.Add Cl.Value
         End If
      Next Cl
      Lst.Sort
      .Range("D4").Resize(Lst.Count).Value = Application.Transpose(Lst.ToArray)
   End With
End Sub
Beaten 2it

Salute to you, Sir.
Will recommend this forum to friends.
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
48,076
Office Version
  1. 365
Platform
  1. Windows
Glad we could help & thanks for the feedback.
 

Peter_SSs

MrExcel MVP, Moderator
Joined
May 28, 2005
Messages
46,837
Office Version
  1. 365
Platform
  1. Windows

ADVERTISEMENT

You are very welcome. :)
 

Peter_SSs

MrExcel MVP, Moderator
Joined
May 28, 2005
Messages
46,837
Office Version
  1. 365
Platform
  1. Windows
and very short code.
Thinking a different way ... for the same layout I had before:

VBA Code:
Sub Extract_List_v2()
  With Range("C2:C" & Range("A" & Rows.Count).End(xlUp).Row)
    .Value = .Offset(, -2).Value
    .Replace What:="(*", Replacement:=""
    .Sort Key1:=.Cells(1), Order1:=xlAscending, Header:=xlNo
    .RemoveDuplicates Columns:=1, Header:=xlNo
  End With
End Sub
 

SoniboiTM

New Member
Joined
Jul 25, 2020
Messages
22
Office Version
  1. 2019
Platform
  1. Windows
  2. Web
Thinking a different way ... for the same layout I had before:

VBA Code:
Sub Extract_List_v2()
  With Range("C2:C" & Range("A" & Rows.Count).End(xlUp).Row)
    .Value = .Offset(, -2).Value
    .Replace What:="(*", Replacement:=""
    .Sort Key1:=.Cells(1), Order1:=xlAscending, Header:=xlNo
    .RemoveDuplicates Columns:=1, Header:=xlNo
  End With
End Sub

Thank you. I will save this post for future reference.
This will be helpful, too.
 

Watch MrExcel Video

Forum statistics

Threads
1,113,936
Messages
5,545,104
Members
410,656
Latest member
Hydraulics
Top