Array Question

[TheShaunMichael]

Hi all,

Have an excel sheet I use to create estimates (each new estimate goes in row 2). Each time I create a new estimate, a row is inserted into column 2 pushing all previous records down. I have about 800 rows now. For each estimate/row, the company name is in Column A.

Ultimately, I need to create an array that returns a list of all unique company names. The challenge is, in my list of 800 estimates, company names in some cases appear 30 or 40 times whereas others appear just once.

I obviously need some type of If then loop to test for existing values within an array. If the value in column A doesn't exist, the value needs to be added, and if it does exist the loop needs to move to the next row.

Many thanks!

 

[T. Valko]

Hi all,

Have an excel sheet I use to create estimates (each new estimate goes in row 2). Each time I create a new estimate, a row is inserted into column 2 pushing all previous records down. I have about 800 rows now. For each estimate/row, the company name is in Column A.

Ultimately, I need to create an array that returns a list of all unique company names. The challenge is, in my list of 800 estimates, company names in some cases appear 30 or 40 times whereas others appear just once.

I obviously need some type of If then loop to test for existing values within an array. If the value in column A doesn't exist, the value needs to be added, and if it does exist the loop needs to move to the next row.

Many thanks!

The easiest method for extracting unique values is to use the advanced filter.

Filter on unique records only and copy to another location.

 

[GTO]

Hi there,

I wasn't sure of where we put the list of uniques names. In a junk copy of your workbook, see if this is close.

Option Explicit
    
Sub exa()
Dim DIC As Object
Dim aryInputOutput As Variant
Dim i As Long
    
    Set DIC = CreateObject("Scripting.Dictionary")
    
    With Sheet1
        aryInputOutput = Range(.Range("A2"), .Cells(.Rows.Count, "A").End(xlUp)).Value
        
        For i = 1 To UBound(aryInputOutput, 1)
            DIC.Item(aryInputOutput(i, 1)) = Empty
        Next
        
        aryInputOutput = DIC.Keys
        .Range("D2").Resize(UBound(aryInputOutput) + 1).Value = Application.Transpose(aryInputOutput)
    End With
End Sub

 

[Rick Rothstein]

At the conclusion of the code below, the NamesOut array will contain a list of the unique names in Column A starting at Row 2 downward (both of which can be configured in the Const statements)...

Dim CompanyNames As New Collection
Dim X As Long, LastRow As Long, NamesOut() As String
Const StartRow As Long = 2
Const NameColumn As String = "A"
LastRow = Cells(Rows.Count, NameColumn).End(xlUp).Row
On Error Resume Next
For X = StartRow To LastRow
  CompanyNames.Add Cells(X, NameColumn).Value, Cells(X, NameColumn).Value
Next
ReDim NamesOut(1 To CompanyNames.Count)
For X = 1 To CompanyNames.Count
  NamesOut(X) = CompanyNames(X)
Next

 

[TheShaunMichael]

That may work and apologies for not specifying. Am hoping to pull up this list of unique company names in a userform_initialize sequence and populate a combo box or list box. If I need to first build the list in a hidden worksheet I suppose I can do that but it would seem that there is a cleaner way.

 

[TheShaunMichael]

Rick that works perfectly!

One thing I didn't consider - anyway to alphabetize the list?

 

[GTO]

Rick that works perfectly!

One thing I didn't consider - anyway to alphabetize the list?

Do you expect the 800 rows to grow to thousands of rows, or can we presume it stays reasonably small?

 

[TheShaunMichael]

I have not thought about limiting it and it does grow by a few rows daily. I will tell you that it will likely take 2-3 years before reaching a few thousand. I'm not sure if you would still consider that reasonable small. What do you have in mind?

 

[Rick Rothstein]

Okay, if you want the names sorted, I figure the fastest way to do that is to let Excel do it. Because of that, I figured I would encode T. Valko's idea of using the Advance Filter and let Excel do all the work. Here is the code that resulted from this idea...

Dim NamesOut As Variant, Addr As String
Dim LastRow As Long, UnusedColumn As Long, RowCount As Long
Const StartRow As Long = 2
Const NameColumn As String = "A"
'
'   Possible lead-in code
'
LastRow = Cells(Rows.Count, NameColumn).End(xlUp).Row
UnusedColumn = Cells.Find(What:="*", SearchOrder:=xlByColumns, _
               SearchDirection:=xlPrevious, LookIn:=xlFormulas).Column + 1
RowCount = LastRow - StartRow + 1
Application.ScreenUpdating = False
With Cells(StartRow, UnusedColumn).Resize(RowCount)
  .Value = .Offset(, 1 - UnusedColumn).Value
  .Sort Key1:=Cells(1, UnusedColumn), Order1:=xlAscending
  .AdvancedFilter Action:=xlFilterInPlace, Unique:=True
  Addr = .SpecialCells(xlCellTypeVisible).Address
  ActiveSheet.ShowAllData
  Range(Addr).Copy Cells(1, UnusedColumn + 1)
  NamesOut = WorksheetFunction.Transpose(Cells(1, UnusedColumn + 1).Resize(RowCount))
  .Resize(, 2).EntireColumn.Clear
End With
Application.ScreenUpdating = True
'
'   At this point, the Variant variable NamesOut contains
'   an array of the sorted, unique names in Column A
'

 

[TheShaunMichael]

This is working beautifully! Two small hang-ups though.

1) The first value in the listbox is repeated twice. I checked carefully for the smallest of spelling errors that would result in 2 values - don't see one and I don't see any other repeated values in the list.

2) It seems that the listbox is populated by correctly since it scrolls for a while. However, about 1/4 of the way down, the values turn blank (like the font was switched to white).

Thank you so much.