Today I’m going to teach you how to use preserve keyword effectively. We use preserve keyword to resize arrays without loosing existing data. But you should use it carefully. Because if you use it unwisely, then it may have huge impact on run time of the program. For an example it is inadvisable to use preserve inside the loops.
So now I will show you how you can avoid using preserve keyword inside loops. Consider following example. This excel sheet has list of names in column A. Assume we have names up to 30,000 rows. If you look at the list carefully you will notice that this list has duplicate names. Our goal is to get unique names to an array.
Here is a one method you can use to do that.
Sub GetUniqueNames() Dim WS As Worksheet Dim AllNames(1 To 30000) As String Dim UniqueNames() As String Dim i As Long Dim j As Long Dim Counter As Long Dim NameFound As Boolean Set WS = ActiveSheet For i = 1 To 30000 AllNames(i) = WS.Range("A" & i).Value Next i ReDim UniqueNames(1 To 1) UniqueNames(1) = AllNames(1) Counter = 1 For i = 1 To 30000 NameFound = False For j = 1 To Counter If StrComp(AllNames(i), UniqueNames(j), vbTextCompare) = 0 Then NameFound = True End If Next j If NameFound = False Then Counter = Counter + 1 ReDim Preserve UniqueNames(1 To Counter) UniqueNames(Counter) = AllNames(i) End If Next i End Sub |
If you look at above code you will notice that there is a nested for loop in above subroutine. And I have placed preserve keyword inside the outer for loop. So when we execute the code, program goes through all the values from 1 to 30000. For each value, it checks whether this current name is already in the UniqueNames array or not. If the value is not in the UniqueNames array then program resize the UniqueNames array copying existing data. Then program add that new name to the end of the array. So this means that when ever there is new name, program need to resize UniqueNames array copying existing data. But this is an expensive operation. So we should try to find different approach for this.
So our goal here is to remove the preserve keyword from the For Loop. To do that, first we need to identify the highest possible size UniqueNames array can have. So in this example it should be 30000. Now we resize the array to it’s highest possible size at the beginning.
ReDim UniqueNames(1 To 30000)
Then we can change the nested For Loop section like this.
Counter = 1 For i = 1 To 30000 NameFound = False For j = 1 To Counter If StrComp(AllNames(i), UniqueNames(j), vbTextCompare) = 0 Then NameFound = True End If Next j If NameFound = False Then UniqueNames(Counter) = AllNames(i) Counter = Counter + 1 End If Next i ReDim Preserve UniqueNames(1 To Counter - 1) |
Here we loop through the values and add new names to UniqueNames array. We calculate the number of unique names using Counter variable. So at then end, we use preserve keyword once to resize the UniqueNames array to it’s correct size.
So the complete code of the second method is as follows.
Sub GetUniqueNames_Method2() Dim WS As Worksheet Dim AllNames(1 To 30000) As String Dim UniqueNames(1 To 30000) As String Dim i As Long Dim j As Long Dim Counter As Long Dim NameFound As Boolean Set WS = ActiveSheet For i = 1 To 30000 AllNames(i) = WS.Range("A" & i).Value Next i Counter = 1 For i = 1 To 30000 NameFound = False For j = 1 To Counter If StrComp(AllNames(i), UniqueNames(j), vbTextCompare) = 0 Then NameFound = True End If Next j If NameFound = False Then UniqueNames(Counter) = AllNames(i) Counter = Counter + 1 End If Next i ReDim Preserve UniqueNames(1 To Counter - 1) End Sub |