Want to become an expert in VBA? So this is the right place for you. This blog mainly focus on teaching how to apply Visual Basic for Microsoft Excel. So improve the functionality of your excel workbooks with the aid of this blog. Also ask any questions you have regarding MS Excel and applying VBA. We are happy to assist you.

How to use preserve keyword in arrays

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

Contact Form

Name

Email *

Message *