0

i have programmed a procedure to find all values of a list and store them in a collection. There are identical values but each value only should be stored once. Here is my vba code:

For intRow = intStart To ActiveSheet.Cells(Rows.count, 1).End(xlUp).Row
           k = 1
           Do
              If k > colData.count Then
                  colData.Add Trim(Cells(intRow, intClmn).Value)
                  Exit Do
              ElseIf Trim(Cells(intRow, intClmn)) = colData.Item(k) Then
                  Exit Do
              End If
              k = k + 1
        Loop
Next i

I wonder if there is a more efficient way to get those values though. Do you know a more efficient way to collect values of a list?

Community
  • 1
  • 1
TimRicta
  • 135
  • 1
  • 2
  • 8
  • You can look this post. Maybe helpful https://stackoverflow.com/questions/48747252/matching-two-column-and-get-values-below-the-matched-column – Deepak Feb 27 '18 at 09:09
  • This is more a code review question though you would need to correct a few things first. There are lots of missing declarations and your i variable should be intRow. That said, put everything into variables (particularly your lastRow calculation), declare your types, stuff the range values into an array and loop that. Use typed functions e.g. Trim$. Avoid function calls in a loop (e.g. create this currentValue = Trim$(ws.Cells(intRow, intClmn)) so you move the Trim call out of the do loop. I could go on. – QHarr Feb 27 '18 at 09:13
  • Also, you need a test for IsEmpty and handling this or you may error out or type mismatch with blank cells in the range. – QHarr Feb 27 '18 at 09:20
  • Thanks @QHarr for those helpful hints. Despite that is there a more efficient approach to generate a list of all values of a list or is this already a efficient way? – TimRicta Feb 27 '18 at 09:21
  • May read range direct into array then call to system.collection [ArrayList](https://msdn.microsoft.com/en-us/library/system.collections.arraylist(v=vs.110).aspx) with a check if not already in list Add and then chuck back out to sheet? Depending on data size I am not sure how this compares with simply using the remove duplicates which is optimized for the part of what you are trying to achieve, – QHarr Feb 27 '18 at 09:22
  • Also look at SortedLists http://www.robvanderwoude.com/vbstech_data_sortedlist.php Don't know if sorting then adds overhead. Might be interesting to test. Hence why more Code Review, – QHarr Feb 27 '18 at 09:28
  • I don't want to change the list on the worksheet, therefore i have to copy the list in a new worksheet and then remove duplicates and then read those values in an array and then delete this temporary worksheet. But i am not sure if this will be more efficenty for a list with a thousend elements. – TimRicta Feb 27 '18 at 09:29
  • Why can't you just read straight into an array and then work with arrays and touch the sheet as little as possible? Large amounts of data this will be faster. – QHarr Feb 27 '18 at 09:30
  • Have you already seen this question: [How do I get a list of unique values from a range in Excel VBA?](https://stackoverflow.com/questions/31690814/how-do-i-get-a-list-of-unique-values-from-a-range-in-excel-vba/31693059#31693059). Could this solution help you? – Daniel Dušek Feb 27 '18 at 09:46
  • @dee that solution is very helpfull. Thank you! – TimRicta Feb 27 '18 at 10:41

2 Answers2

0

If I've understood then I would record copying and pasting the column to a blank worksheet, and using the Remove Duplicates feature on this area to result in a column of distinct values that you can iterate.

As the new (temporary) worksheet is blank other than the retained values, you could use UsedRange to iterate all its cells:

For rng In Sheets("TempSht").UsedRange

Next rng

or again use End(xlUp) (or xlDown).


Could even get the entire range into an array if appropriate:

Dim arr As Variant

arr = WorksheetFunction.Transpose(Range("A1:A3"))
Andy G
  • 19,232
  • 5
  • 47
  • 69
  • I am not sure if adding a whole new worksheet is more efficient than this subroutine. Adding values in a new worksheet need a lot of computing power though, especially for long lists. I am more looking for a possibilitiy to get this problem solved more efficient within an array or a collection of strings. – TimRicta Feb 27 '18 at 09:09
  • If there were lots of rows and lots of duplicates then I'd still favour my approach. But I've probably misunderstood your requirements. – Andy G Feb 27 '18 at 09:17
0

I ommited declaration of intStart and intClmn as well as calculating their values.
You can use Dictionary object and operate with an array instead of cells.
You need to add a reference in order to use early binding, a great answer is already here. You need Microsoft Scripting Runtime reference.

Dim vArr(), i As Long, j As Long, DataRange As Range
'Dim intStart As Long, intClmn As Long

'intStart = 1: intClmn = 7

'   Declaring and creating a dictionary (choose one and wisely)
'--------------------------------------------------------------
'   Late binding
Dim iDict As Object
Set iDict = CreateObject("Scripting.Dictionary")

'   Early binding (preferable, you need to enable reference)
'Dim iDict As Scripting.Dictionary
'Set iDict = New Scripting.Dictionary
'--------------------------------------------------------------

'    Define range of your data (may vary, modify so it suits your needs)
With ActiveSheet
    Set DataRange = .Range(.Cells(intStart, 1), _
                            .Cells(.Cells(.Rows.Count, 1).End(xlUp).Row, intClmn))
End With

'   Populate an array with trimmed values
'   I'm not sure how productive it is comparing to calling Trim in a loop so..
'   You're free to test it
vArr = Evaluate("IF(ROW(), TRIM(" & DataRange.Address & "))")

'    Loop through array
For i = LBound(vArr, 1) To UBound(vArr, 1)
    For j = LBound(vArr, 2) To UBound(vArr, 2)
        '    Add an item with the key of vArr(i, j),
        '    otherwise change an existing item with this key to vArr(i, j)
        iDict(vArr(i, j)) = vArr(i, j)
    Next j
Next i
AntiDrondert
  • 1,128
  • 8
  • 21
  • Get rid of those calls to Trim inside loops where possible! Also, consider typed functions. Admittedly, not gonna mean m̶a̶j̶o̶r̶ ̶ noticeable savings but it isn't necessary. – QHarr Feb 27 '18 at 09:44
  • And you could offer OP the faster early binding option as a mention though I get why you have used late. Sorry to troll your answer. – QHarr Feb 27 '18 at 09:50
  • @QHarr I use late binding, because I do not know how to enable references on remote PCs (since I'm not the only user of my, ehrm, "applications") by VBA module ^^', but thats the topic for another question, I will include early binding in the edit. – AntiDrondert Feb 27 '18 at 09:55
  • I only meant you could mention it as an option but now you have come back with the enabling references I am wondering if I should have kept my mouth shut as you'll end up having to explain it as well! :-) – QHarr Feb 27 '18 at 09:57
  • Thank you very much for your help. I will use your approaches and helpfull hints! – TimRicta Feb 27 '18 at 10:05
  • @QHarr Any advice to remove `Trim` in the loop? I'm out of ideas and it will help me in future projects as well. – AntiDrondert Feb 27 '18 at 10:45
  • In a meeting will have a look after. I think my initial observation was minimise the calls so have only where absolutely necessary e.g. use trim when assigning to a variable once in outer loop – QHarr Feb 27 '18 at 11:17
  • Looks like you have effectively removed anyway by doing a one off call. – QHarr Feb 27 '18 at 11:25