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

SoniboiTM

New Member
Joined
Jul 25, 2020
Messages
38
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:

Excel Facts

Difference between two dates
Secret function! Use =DATEDIF(A2,B2,"Y")&" years"&=DATEDIF(A2,B2,"YM")&" months"&=DATEDIF(A2,B2,"MD")&" days"

Peter_SSs

MrExcel MVP, Moderator
Joined
May 28, 2005
Messages
54,435
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
 
Solution

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
73,434
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
38
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
38
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
73,434
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
54,435
Office Version
  1. 365
Platform
  1. Windows

ADVERTISEMENT

You are very welcome. :)
 

Peter_SSs

MrExcel MVP, Moderator
Joined
May 28, 2005
Messages
54,435
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
38
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.
 
Master Excel Bundle

Excel contains over 450 functions, with more added every year. That’s a huge number, so where should you start? Right here with this bundle.

Forum statistics

Threads
1,164,601
Messages
5,838,281
Members
430,536
Latest member
Manoj Gaidhankar

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top