PDA

View Full Version : Sleeper: Merge dynamic array list



cazamic
04-25-2005, 03:38 AM
:dunno Hi

Please can someone help me, I am new to VBA. I have a program that merges 2 lists into one. I am trying to change it into a dynamic array. I have started to but I get stuck with the for loop.

Below is the code.


Sub MergeLists()
Dim List1() As String, List2() As String
Dim List3() As String
Dim Index1 As Integer, Index2 As Integer, Index3 As Integer
Dim Name1 As String, Name2 As String
Dim NI As Integer
'For loop variable
Dim i As Integer
' With Range("A4")
' NI = Range(.Offset(1, 0), .End(xlDown)).Rows.Count
' End With
'Copy Customer name into array list 1 and list 2
For i = 1 To 93
List1(i) = Range("A5").Cells(i)
Next i
For i = 1 To 102
List2(i) = Range("B5").Cells(i)
Next i
'Initialise index for ist 1 and List 2
Index1 = 1
Index2 = 1
'Implete merge algorit
Do While (Index1 <= 93) And (Index2 <= 102)
Name1 = List1(Index1)
Name2 = List2(Index2)
Index3 = Index3 + 1
ReDim Preserve List3(Index3)
If Name1 < Name2 Then
List3(Index3) = Name1
Index1 = Index1 + 1
ElseIf Name1 > Name2 Then
List3(Index3) = Name2
Index2 = Index2 + 1
Else
List3(Index3) = Name1
Index1 = Index1 + 1
Index2 = Index2 + 1
End If
Loop
'copy remaining names lseft in List 1 to List 3
For i = Index1 To 93
Index3 = Index3 + 1
ReDim Preserve List3(Index3)
List3(Index3) = List1(i)
Next i
'copy any remaining names left in list 2 to list 3
For i = Index2 To 102
Index3 = Index3 + 1
ReDim Preserve List3(Index3)
List3(Index3) = List2(i)
Next i
' Using For loop copy each name into merged list 3 to column D of worksheet
With Range("D4")
For i = 1 To Index3
.Offset(i, 0).Value = List3(i)
Next i
End With
'Place curser in cell A2
Range("A2").Select
End Sub

Killian
04-25-2005, 05:45 AM
Your trying to iterate through an array that you haven't defined (in terms of the number of elements it has). You should either do it when you dimension them at the top of the sub or (if you may be using a varible depending on the size of your range) re-dimension them before you want to use them


ReDim List1(1 To 93)
For i = 1 To 93
List1(i) = Range("A5").Cells(i)
Next i
ReDim List2(1 To 102)
For i = 1 To 102
List2(i) = Range("B5").Cells(i)
Next i

Also, I was a little curious as to why you need use several arrays to hold these values rather than just going through the each cell in the range (of name1's) compare to the corresponding cell (in range of name2's) and output the result to the target cell?

mvidas
04-25-2005, 10:44 AM
Also, I was a little curious as to why you need use several arrays to hold these values rather than just going through the each cell in the range (of name1's) compare to the corresponding cell (in range of name2's) and output the result to the target cell?

Or even better just using one array to hold the unique values of the two columns, then transfer that array to the target region


Sub MergeLists()
Dim TheList() As String, i As Long, j As Long, ListCount As Long
'Initialize array counting variable
ListCount = 0
ReDim TheList(ListCount)
'Add unique names from column A and B to array
j = Range("A65536").End(xlUp).Row
If j > 4 Then
For i = 5 To j
If Not InStringArray(TheList, Range("A" & i).Text) Then
ReDim Preserve TheList(ListCount)
TheList(ListCount) = Range("A" & i).Text
ListCount = ListCount + 1
End If
Next i
End If
j = Range("B65536").End(xlUp).Row
If j > 4 Then
For i = 5 To j
If Not InStringArray(TheList, Range("B" & i).Text) Then
ReDim Preserve TheList(ListCount)
TheList(ListCount) = Range("B" & i).Text
ListCount = ListCount + 1
End If
Next i
End If
'Transfer array contents to column D
For i = 0 To ListCount - 1
Range("D5").Offset(i, 0) = TheList(i)
Next i
End Sub

Function InStringArray(ByRef vArray() As String, ByRef sValue As String) As Boolean
Dim i As Long
For i = LBound(vArray) To UBound(vArray)
If vArray(i) = sValue Then InStringArray = True: Exit Function
Next i
InStringArray = False
End Function

Matt

cazamic
04-26-2005, 09:04 AM
I know, it was a fixed array, but I was told to change it to a dynamic array. I half started in my code, but got stuck. How do you iterate through a dynamic array? Thanks for helping.


Your trying to iterate through an array that you haven't defined (in terms of the number of elements it has). You should either do it when you dimension them at the top of the sub or (if you may be using a varible depending on the size of your range) re-dimension them before you want to use them


ReDim List1(1 To 93)
For i = 1 To 93
List1(i) = Range("A5").Cells(i)
Next i
ReDim List2(1 To 102)
For i = 1 To 102
List2(i) = Range("B5").Cells(i)
Next i

Also, I was a little curious as to why you need use several arrays to hold these values rather than just going through the each cell in the range (of name1's) compare to the corresponding cell (in range of name2's) and output the result to the target cell?

Hi thanks for your help. Can you explain why the range is ("A65536")? That has confused me.


Or even better just using one array to hold the unique values of the two columns, then transfer that array to the target region


Sub MergeLists()
Dim TheList() As String, i As Long, j As Long, ListCount As Long
'Initialize array counting variable
ListCount = 0
ReDim TheList(ListCount)
'Add unique names from column A and B to array
j = Range("A65536").End(xlUp).Row
If j > 4 Then
For i = 5 To j
If Not InStringArray(TheList, Range("A" & i).Text) Then
ReDim Preserve TheList(ListCount)
TheList(ListCount) = Range("A" & i).Text
ListCount = ListCount + 1
End If
Next i
End If
j = Range("B65536").End(xlUp).Row
If j > 4 Then
For i = 5 To j
If Not InStringArray(TheList, Range("B" & i).Text) Then
ReDim Preserve TheList(ListCount)
TheList(ListCount) = Range("B" & i).Text
ListCount = ListCount + 1
End If
Next i
End If
'Transfer array contents to column D
For i = 0 To ListCount - 1
Range("D5").Offset(i, 0) = TheList(i)
Next i
End Sub

Function InStringArray(ByRef vArray() As String, ByRef sValue As String) As Boolean
Dim i As Long
For i = LBound(vArray) To UBound(vArray)
If vArray(i) = sValue Then InStringArray = True: Exit Function
Next i
InStringArray = False
End Function

Matt

mvidas
04-26-2005, 09:17 AM
Hi thanks for your help. Can you explain why the range is ("A65536")? That has confused me.

I'm actually using Range("A65536").End(xlUp).Row which is the same as going to A65536, then pressing control-up (to find the last used cell there), then returning that row. I often will go to x65536.End(xlUp) as it is often (not always) the best way of determining the last used cell in the column. That way you don't have to hardcode 93 into the code in case you add/delete some records.
Matt

cazamic
04-26-2005, 11:04 AM
HI thanks again. Can you explain this part of the code though please...


Function InStringArray(ByRef vArray() As String, ByRef sValue As String) As Boolean
Dim i As Long
For i = LBound(vArray) To UBound(vArray)
If vArray(i) = sValue Then InStringArray = True: Exit Function
Next i
InStringArray = False
End Function

Also I dont understand this part..If j > 4 what is that for.

Basically I am a student and have been doing this for not very long. I had these lists and this is the hint they gave me for making it dynamic....


With Range("A4")
NI = Range(.Offset(1, 0), .End(xlDown)).Rows.Count
End With

Your code works which is good but I need to understand if or I shouldnt use it. Can you comment please?

Your a star!

mvidas
04-26-2005, 11:30 AM
As for the function explanation, here is the function code commented:


'InStringArray boolean function returns true if sValue is in vArray
Function InStringArray(ByRef vArray() As String, ByVal sValue As String) As Boolean
' Dimension variable to be used as array index
Dim i As Long
' Loop index variable for each item of array, from lower bound to upper bound
For i = LBound(vArray) To UBound(vArray)
' If that array item's value is sValue, then item is in array, and function
' can be exited with function value being True
If vArray(i) = sValue Then InStringArray = True: Exit Function
' loop to next item's index
Next i
' This is only processed if sValue wasn't found in array, makes function return
' a false value
InStringArray = False
End Function

And here is the Sub


Sub MergeLists()
Dim TheList() As String, i As Long, j As Long, ListCount As Long
' Initialize array counting variable
ListCount = 0
' Redimensions array variable so it can be passed to InStringArray function
' (otherwise there will be no bounds to the array and the function errors)
ReDim TheList(ListCount)
' Add unique names from column A and B to array
' Returns the last used row number in column A to variable j
j = Range("A65536").End(xlUp).Row
' if j is greater than 4, then there is data in the sheet (as rows 5 and above
' are the data rows, based on your description)
If j > 4 Then
' 'i' variable is used to loop through the used cells in column A
For i = 5 To j
' If the cell in column A is not already in TheList array variable...
If Not InStringArray(TheList, Range("A" & i).Text) Then
' This is dynamically increasing the size of the array
ReDim Preserve TheList(ListCount)
' Puts that cell's contents into end of array
TheList(ListCount) = Range("A" & i).Text
' Increases array counting variable
ListCount = ListCount + 1
End If 'If Not InStringArray ....
' go to next cell
Next i
End If 'If j > 4 ...
' Same logic as above, but using column B instead of A
j = Range("B65536").End(xlUp).Row
If j > 4 Then
For i = 5 To j
If Not InStringArray(TheList, Range("B" & i).Text) Then
ReDim Preserve TheList(ListCount)
TheList(ListCount) = Range("B" & i).Text
ListCount = ListCount + 1
End If
Next i
End If
' Transfer array contents to column D
' I have listcount - 1 as listcount is increased whenever anything is added to
' the array variable for easier re-dimensioning
For i = 0 To ListCount - 1
' Enter array entry into column D
Range("D5").Offset(i, 0) = TheList(i)
' Next entry
Next i
End Sub


Hopefully those are commented enough, but as arrays can get tricky please feel free to ask about what you don't understand!

Matt