Arrays

[chapster21]

I have two lists of names. Column A and Column B.Some names are in both lists. I have to write a sub that captures the 2 lists in 2 arrays. Then create 3 arrays from that info. 1 new array is for names that are only in the previous year, one is for names only in the current year, and the 3rd for names that are in both lists. It does not run correctly. Any ideas?

See later post for code.

[mdmackillop]

Hi Chapster,
Use the green VBA button to format yout code
Regards
MD

[chapster21]

Ok. Thanks.
Can anyone help? Or should I post somewhere else?

[GTO]

Greetings Chapster,

It's Friday/weekend, so you might have to exercise a bit of patience. In the meantime, for those of us with less-than-stellar visualization skills, you might want to attach a sample workbook. Makes it easier to see what is happening and what might be erroring.

Mark

[chapster21]

Updated code. I figured out how to get the column "customers both years" filled. Now I just cannot get the other two taken care of. The workbook is attached. The button in the sheet is insignicant.
By the way, thanks. My last post was just from experience of waiting endlessly on other sites.


[vba]
Option Explicit
Option Base 1
Sub CustList()
Dim i1, i2, i3, i4, i5 As Integer
Dim size1, size2, size3, size4, size5 As Integer
Dim list1(), list2(), list3(), list4(), list5() As String
Dim index1, index2, index3 As Integer
Dim name1, name2, name3 As String
With Range("F3")
Range(.Offset(1, 0), .Offset(1, 0).End(xlDown)).ClearContents
End With

With Range("A3")
size1 = Range(.Offset(1, 0), .End(xlDown)).Rows.Count
ReDim list1(size1)
For i1 = 1 To size1
list1(i1) = .Offset(i1, 0)
Next
size2 = Range(.Offset(1, 1), .Offset(0, 1).End(xlDown)).Rows.Count
ReDim list2(size2)
For i2 = 1 To size2
list2(i2) = .Offset(i2, 1)
Next
size5 = Range(.Offset(1, 0), .Offset(1, 1).End(xlDown)).Rows.Count
ReDim list5(size5)
For i5 = 1 To size5
list5(i5) = .Offset(i5, 1)
Next
End With





size4 = 0
size5 = 0
index1 = 1
index2 = 1

name1 = list1(index1)
name2 = list2(index2)


Do While index1 <= size1 And index2 <= size2
name1 = list1(index1)
name2 = list2(index2)
size5 = size5 + 1
ReDim Preserve list5(size5)

If name1 < name2 Then
index1 = index1 + 1
ElseIf name1 > name2 Then
index2 = index2 + 1
ElseIf name1 = name2 Then
list5(size5) = name1
index1 = index1 + 1
index2 = index2 + 1
End If
Loop

With Range("F3")
For i5 = 1 To size5
.Offset(i5, 0) = list5(i5)
Next
End With

Range("F4:F200").Select
Selection.SpecialCells(xlCellTypeBlanks).Delete (xlShiftUp)

size3 = 0

With Range("F3")
size3 = Range(.Offset(1, 0), .End(xlDown)).Rows.Count
ReDim list3(size3)
For i3 = 1 To size3
list3(i3) = .Offset(i3, 1)
Next
End With

With Range("D3")
Range(.Offset(1, 0), .Offset(1, 0).End(xlDown)).ClearContents
End With
size3 = 0
index3 = 1
name3 = list3(index3)
Do While index1 <= size1 And index3 <= size3
name1 = list1(index1)
name3 = list3(index3)
size3 = size3 + 1
ReDim Preserve list3(size3)

If name1 = name3 Then
index1 = index1 + 1
index3 = index3 + 1
ElseIf name1 <> name3 Then
list3(size3) = name1
index1 = index1 + 1
End If
Loop

With Range("D3")
For i3 = 1 To size3
.Offset(i3, 0) = list3(i3)
Next
End With
End Sub

[/vba]

[Demosthine]

Evening Youngin'

I copied your explanation and came up with the following description for an example workbook.

1.) Row 1 is blank.
2.) Row 2 is blank.
3.) Row 3 has Column Headings
a.) Column A = "Year 2007"
b.) Column B = "Year 2008"
c.) Column C = <Blank>
d.) Column D = "First Year Member"
e.) Column E = "Second Year Member"
f.) Column F = "Member Both Years"
4.) Row 4 starts list of Names.


Now, I added a list of names to the list and here is what I found...
As you are cycling through the list for the first time,
- if your Name in Column 1 is not found in Column 2, add it to Column 3. Increment Column 1. Good.
- if your Name in Column 1 is found in Column 2, add it to Column 5. Increment Column 2. Good.
- LOOP

As you are cycling through the list for the second time,
- if your Name in Column 2 is not found in Column 2 starting from where you left off in Column 2 during the previous loop, add it to Column 3. Bad.

At the start of each Loop, you need to reset the second Column to start at the top. That way it includes all names. Otherwise, you will be missing all of the previous names as you continue through your code.


Once that is corrected, you'll find that as you loop through, you are comparing all of the names in Column 1 to only the first name in Column 2. You need to have a nested loop to compare each name in Column 1 to each name in Column 2.

That should get you going.
Scott

[malik641]

I like Scott has done for you, chapster21. Try to work on fixing your code so it works and then I'll post the code I wrote up that I think you'll like.

[uvba]Option Explicit

Public Sub Make3Arrays()
Application.ScreenUpdating = False

Dim ws As Excel.Worksheet, wsNew As Excel.Worksheet
Const startRow As Long = 4
Dim rngCustomersLastYear As Excel.Range
Dim rngCustomersThisYear As Excel.Range
Dim arrayCustomersLastYear() As String
Dim arrayCustomersThisYear() As String
Dim arrayCustomersBothYears() As String
Dim lastYearCount As Long, thisYearCount As Long
Dim bothYearsCount As Long, i As Long
Const lastYearColumn As Long = 1, thisYearColumn As Long = 2

ReDim arrayCustomersLastYear(0)
ReDim arrayCustomersThisYear(0)
ReDim arrayCustomersBothYears(0)

Set ws = ThisWorkbook.Worksheets("Lists")
Set rngCustomersLastYear = _
ws.Range(ws.Cells(startRow, lastYearColumn), _
ws.Cells(ws.Rows.Count, lastYearColumn).End(xlUp))
Set rngCustomersThisYear = _
ws.Range(ws.Cells(startRow, thisYearColumn), _
ws.Cells(ws.Rows.Count, thisYearColumn).End(xlUp))

' loop Customers Last Year
For i = startRow To ws.Cells(ws.Rows.Count, lastYearColumn).End(xlUp).Row
' check if name in other list
If (IsInList(ws.Cells(i, lastYearColumn).Value, rngCustomersThisYear)) Then
' put in third array
ReDim Preserve arrayCustomersBothYears(bothYearsCount)
arrayCustomersBothYears(bothYearsCount) = ws.Cells(i, lastYearColumn).Value
bothYearsCount = bothYearsCount + 1
Else
' put in first array
ReDim Preserve arrayCustomersLastYear(lastYearCount)
arrayCustomersLastYear(lastYearCount) = ws.Cells(i, lastYearColumn).Value
lastYearCount = lastYearCount + 1
End If
Next i

' loop customers This Year
For i = startRow To ws.Cells(ws.Rows.Count, thisYearColumn).End(xlUp).Row
' check if name in other list - this time we don't do anything
' if it is because we already made the third array
If (IsInList(ws.Cells(i, thisYearColumn).Value, rngCustomersLastYear) = False) Then
' put in second array
ReDim Preserve arrayCustomersThisYear(thisYearCount)
arrayCustomersThisYear(thisYearCount) = ws.Cells(i, thisYearColumn).Value
thisYearCount = thisYearCount + 1
End If
Next i

' output 3 arrays to new sheet
Set wsNew = ThisWorkbook.Worksheets.Add(After:=ThisWorkbook.Worksheets(ThisWorkbook.Wor ksheets.Count))
wsNew.Cells(1, 1).Value = "Customers Last Year"
wsNew.Cells(1, 2).Value = "Customers This Year"
wsNew.Cells(1, 3).Value = "Customers Both Years"

wsNew.Range(wsNew.Cells(2, 1), wsNew.Cells(lastYearCount + 1, 1)).Value = _
WorksheetFunction.Transpose(arrayCustomersLastYear)

wsNew.Range(wsNew.Cells(2, 2), wsNew.Cells(thisYearCount + 1, 2)).Value = _
WorksheetFunction.Transpose(arrayCustomersThisYear)

wsNew.Range(wsNew.Cells(2, 3), wsNew.Cells(bothYearsCount + 1, 3)).Value = _
WorksheetFunction.Transpose(arrayCustomersBothYears)

wsNew.Columns.AutoFit

Application.ScreenUpdating = True
End Sub

Public Function IsInList(ByRef lookFor As String, ByRef inRange As Excel.Range) As Boolean
Dim rng As Excel.Range
Set rng = inRange.Find(What:=lookFor, MatchCase:=False)
IsInList = Not rng Is Nothing
End Function[/uvba]

[chapster21]

thanks Scott and Joseph. I will work on that later today and repost. Actually, I had some really bad code in my first post, went back to the drawing board for 12 hours and came up with what I posted yesterday. I did post my code in the VBA box by clicking on the green VBA button. I am not sure why you do not see it formatted.
Thanks again
-Mike

[chapster21]

'
'
Workbook is attached at bottom of post.

Ok. I have spent a Saturday working on this. Something must be wrong with me. Anyway. I have most of column F filled up but a few names do not show up. For some reason the D column is a copy of column A. I have not even tried column E until I can get the other figured out.

[vba]
Option Explicit
Option Base 1
Sub CustList()
Dim i1 As Integer, i2 As Integer, i3 As Integer, i4 As Integer, i5 As Integer
Dim size1 As Integer, size2 As Integer, size3 As Integer, size4 As Integer, size5 As Integer
Dim list1() As String, list2() As String, list3() As String, list4() As String, list5() As String
Dim index1 As Integer, index2 As Integer, index3 As Integer
Dim name1 As Variant, name2 As Variant, name3 As String

With Range("D3:F150")
Range(.Offset(1, 0), .Offset(1, 0).End(xlDown)).ClearContents
End With

Application.ScreenUpdating = False

With Range("A3")

size1 = Range(.Offset(1, 0), .End(xlDown)).Rows.Count
ReDim list1(size1)
For i1 = 1 To size1
list1(i1) = .Offset(i1, 0)
Next
size2 = Range(.Offset(1, 1), .End(xlDown)).Rows.Count
ReDim list2(size2)
For i2 = 1 To size2
list2(i2) = .Offset(i2, 1)
Next
End With

size5 = 0
size3 = 0
index1 = 1
index2 = 1

Do While index1 <= size1 ' And index2 <= size2

name1 = list1(index1)
name2 = list2(index2)


For Each name1 In list1
index2 = 1
For Each name2 In list2


If name1 = name2 Then
size5 = size5 + 1
ReDim Preserve list5(size5)
list5(size5) = name1
index2 = index2 + 1
index1 = index1 + 1
Exit For
ElseIf name1 <> name2 Then
index2 = index2 + 1
size3 = size3 + 1
ReDim Preserve list3(size3)
list3(size3) = name1
End If

Next name2


index1 = index1 + 1
Next name1

Loop


With Range("D3")
For i3 = 1 To size3
.Offset(i3, 0) = list3(i3)
Next
End With

With Range("F3")
For i5 = 1 To size5
.Offset(i5, 0) = list5(i5)
Next
End With
Range("D4:F200").Select
Selection.SpecialCells(xlCellTypeBlanks).Delete (xlShiftUp)

Range("A2").Select
End Sub
[/vba]

[mdmackillop]

Hi Chapster,
Checking each item in one array against each in another is labourious and fiddly (as you have found out). Consider using the Match function instead.
Personally, I would not use arrays here. You can compare the items using Find (similar reasoning would be used with Match)
[vba]
Option Explicit
Sub CustList()
Dim LastY As Range, ThisY As Range, r As Range, s As Range
Dim Test As Range
With Range("D3:F150")
Range(.Offset(1, 0), .Offset(1, 0).End(xlDown)).ClearContents
End With
Application.ScreenUpdating = False

'Compare last year
With Range("A3")
Set LastY = Range(.Offset(1, 0), .End(xlDown))
Set ThisY = Range(.Offset(1, 1), .Offset(1, 1).End(xlDown))
End With
For Each r In LastY
Set Test = ThisY.Find(r, lookat:=xlWhole)

If Test Is Nothing Then
'Not in This Year
Cells(Rows.Count, 4).End(xlUp).Offset(1) = r
Else
'In This Year
Cells(Rows.Count, 6).End(xlUp).Offset(1) = r
End If
Next
'compare This Year
For Each s In ThisY
Set Test = LastY.Find(s, lookat:=xlWhole)
If Test Is Nothing Then
'Not in Last Year
Cells(Rows.Count, 5).End(xlUp).Offset(1) = s
End If
Next

End Sub

[/vba]

[mdmackillop]

BTW this will return a wrong result
[VBA]size2 = Range(.Offset(1, 1), .End(xlDown)).Rows.Count
[/VBA]
you need
[VBA]
size2 = Range(.Offset(1, 1), .Offset(1, 1).End(xlDown)).Rows.Count

[/VBA]

[chapster21]

Thanks Joseph. Unfortunately, I have to use arrays.

[malik641]

Thanks Joseph. Unfortunately, I have to use arrays.

??? I think you meant mdmackillop.


Here was the code that I came up with a few days ago for your solution. It uses arrays. Let me know if you don't understand anything.
[vba]Option Explicit

Public Sub Make3Arrays()
Application.ScreenUpdating = False

Dim ws As Excel.Worksheet, wsNew As Excel.Worksheet
Const startRow As Long = 4
Dim rngCustomersLastYear As Excel.Range
Dim rngCustomersThisYear As Excel.Range
Dim arrayCustomersLastYear() As String
Dim arrayCustomersThisYear() As String
Dim arrayCustomersBothYears() As String
Dim lastYearCount As Long, thisYearCount As Long
Dim bothYearsCount As Long, i As Long
Const lastYearColumn As Long = 1, thisYearColumn As Long = 2

ReDim arrayCustomersLastYear(0)
ReDim arrayCustomersThisYear(0)
ReDim arrayCustomersBothYears(0)

Set ws = ThisWorkbook.Worksheets("Lists")
Set rngCustomersLastYear = _
ws.Range(ws.Cells(startRow, lastYearColumn), _
ws.Cells(ws.Rows.Count, lastYearColumn).End(xlUp))
Set rngCustomersThisYear = _
ws.Range(ws.Cells(startRow, thisYearColumn), _
ws.Cells(ws.Rows.Count, thisYearColumn).End(xlUp))

' loop Customers Last Year
For i = startRow To ws.Cells(ws.Rows.Count, lastYearColumn).End(xlUp).Row
' check if name in other list
If (IsInList(ws.Cells(i, lastYearColumn).Value, rngCustomersThisYear)) Then
' put in third array
ReDim Preserve arrayCustomersBothYears(bothYearsCount)
arrayCustomersBothYears(bothYearsCount) = ws.Cells(i, lastYearColumn).Value
bothYearsCount = bothYearsCount + 1
Else
' put in first array
ReDim Preserve arrayCustomersLastYear(lastYearCount)
arrayCustomersLastYear(lastYearCount) = ws.Cells(i, lastYearColumn).Value
lastYearCount = lastYearCount + 1
End If
Next i

' loop customers This Year
For i = startRow To ws.Cells(ws.Rows.Count, thisYearColumn).End(xlUp).Row
' check if name in other list - this time we don't do anything
' if it is because we already made the third array
If (IsInList(ws.Cells(i, thisYearColumn).Value, rngCustomersLastYear) = False) Then
' put in second array
ReDim Preserve arrayCustomersThisYear(thisYearCount)
arrayCustomersThisYear(thisYearCount) = ws.Cells(i, thisYearColumn).Value
thisYearCount = thisYearCount + 1
End If
Next i

' output 3 arrays to new sheet
Set wsNew = ThisWorkbook.Worksheets.Add(After:=ThisWorkbook.Worksheets(ThisWorkbook.Wor ksheets.Count))
wsNew.Cells(1, 1).Value = "Customers Last Year"
wsNew.Cells(1, 2).Value = "Customers This Year"
wsNew.Cells(1, 3).Value = "Customers Both Years"

wsNew.Range(wsNew.Cells(2, 1), wsNew.Cells(lastYearCount + 1, 1)).Value = _
WorksheetFunction.Transpose(arrayCustomersLastYear)

wsNew.Range(wsNew.Cells(2, 2), wsNew.Cells(thisYearCount + 1, 2)).Value = _
WorksheetFunction.Transpose(arrayCustomersThisYear)

wsNew.Range(wsNew.Cells(2, 3), wsNew.Cells(bothYearsCount + 1, 3)).Value = _
WorksheetFunction.Transpose(arrayCustomersBothYears)

wsNew.Columns.AutoFit

Application.ScreenUpdating = True
End Sub

Public Function IsInList(ByRef lookFor As String, ByRef inRange As Excel.Range) As Boolean
Dim rng As Excel.Range
Set rng = inRange.Find(What:=lookFor, MatchCase:=False)
IsInList = Not rng Is Nothing
End Function[/vba]

[mdmackillop]

Thanks Joseph. Unfortunately, I have to use arrays.

Can I ask why? Is this a homework assignment?

[malik641]

If this IS a homework assignment, I wouldn't recommend copying our solutions. Your teacher will be expecting a lot from you on the next assignment.

[chapster21]

It is an assignment. That is why I did everything that I could to figure it out myself. I have spent over 20 hours trying to figure this problem out.
Your code is probably a little more complex than what is expected. Thank you though. I will just turn in what I have and suffer the given grade. I am not trying to get others to do my work, but the professor does encourage getting help if needed. This is a distance course and he is not offering any in person instruction. I have two kids, full time job, and I am just having a really hard time figuring this stuff out. It is taking time away from other priorities.
Thanks guys

[Demosthine]

Good Morning All.

Chapster, we are all willing to help out with homework assignments and you are more than welcome to come ask for help. Please, though, make sure you specify that it is an assignment and when the assignment is due. If you look through my posts, I provide a lot more of the educational posts rather than just posting code, rather than just providing code. I find that is much more beneficial for you and very fulfilling when you figure it out.

Malik's example was almost identical to my second method. The only difference was that I didn't place the .Find Function in a separate Function.

When is your assignment actually due?

Scott

[mdmackillop]

You were actually very close to a working solution, so here's a little assistance with your own methodology.

For good assignment marks, you should be adding comments. It helps with future updates/changes and can clarify in your own mind what each step should achieve.


[VBA]
Option Explicit
Option Base 1

Sub CustList()
Dim i1 As Integer, i2 As Integer, i3 As Integer, i4 As Integer, i5 As Integer
Dim size1 As Integer, size2 As Integer, size3 As Integer, size4 As Integer, size5 As Integer
Dim list1() As String, list2() As String, list3() As String, list4() As String, list5() As String
Dim index1 As Integer, index2 As Integer, index3 As Integer
Dim name1 As Variant, name2 As Variant, name3 As String
Dim List6()


ReDim List6(500)

With Range("D3:F150")
Range(.Offset(1, 0), .Offset(1, 0).End(xlDown)).ClearContents
End With

Application.ScreenUpdating = False

With Range("A3")

size1 = Range(.Offset(1, 0), .End(xlDown)).Rows.Count
ReDim list1(size1)
For i1 = 1 To size1
list1(i1) = .Offset(i1, 0)
Next
'Fix reference
size2 = Range(.Offset(1, 1), .Offset(1, 1).End(xlDown)).Rows.Count
ReDim list2(size2)
For i2 = 1 To size2
list2(i2) = .Offset(i2, 1)
Next
End With

size5 = 0
size3 = 0
index1 = 1
index2 = 1

Do While index1 <= size1 And index2 <= size2

'What does this do?
name1 = list1(index1)
name2 = list2(index2)


For Each name1 In list1
index2 = 1
For Each name2 In list2
'If name in both lists, add to List5
If name1 = name2 Then
size5 = size5 + 1
ReDim Preserve list5(size5)
list5(size5) = name1
index2 = index2 + 1
index1 = index1 + 1
'Exit For
'You need to avoid incrementing size3
GoTo skipped
ElseIf name1 <> name2 Then
index2 = index2 + 1
End If
Next name2
'If not, add to List3
'This will increment for each item in List1
size3 = size3 + 1
ReDim Preserve list3(size3)
list3(size3) = name1
index1 = index1 + 1
skipped:
Next name1

Loop


With Range("D3")
For i3 = 1 To size3
.Offset(i3, 0) = list3(i3)
Next
End With

With Range("F3")
For i5 = 1 To size5
.Offset(i5, 0) = list5(i5)
Next
End With
Range("D4:F200").Select
Selection.SpecialCells(xlCellTypeBlanks).Delete (xlShiftUp)

Range("A2").Select
End Sub

[/VBA]

[p45cal]

Comments in the code - I leave it to you to add any further Dim statements as I haven't used Option Explicit. See attachment also.
[vba]Sub blah()
Dim LastYearOnly(), ThisYearOnly(), BothYears() 'Arrays for results
LYOIndex = 0: TYOIndex = 0: BYIndex = 0 'Pointer to last member of each array (not needed but help clarity)
LastYear = Application.Transpose(Range(Range("A4"), Range("A4").End(xlDown))) 'Create array of pre-existing list.
ThisYear = Application.Transpose(Range(Range("B4"), Range("B4").End(xlDown))) 'as above

For i = 1 To UBound(ThisYear) 'taking each name in this year's list...
MatchFound = False
For j = 1 To UBound(LastYear) '...compare it to each name in last year's list...
If ThisYear(i) = LastYear(j) Then MatchFound = True: Exit For '...abandoning loop if a match is found.
Next j

If MatchFound Then 'the name must be in both lists so add it to the new Both Years list:
BYIndex = BYIndex + 1
ReDim Preserve BothYears(1 To BYIndex) 'extend the size of the new array
BothYears(BYIndex) = ThisYear(i) ' insert the name
Else ' the name was only in the original this year's list, so add it to the new This Year Only list:
TYOIndex = TYOIndex + 1
ReDim Preserve ThisYearOnly(1 To TYOIndex)
ThisYearOnly(TYOIndex) = ThisYear(i)
End If
Next i

For i = 1 To UBound(LastYear) 'taking each name in the original last year's list...
MatchFound = False
For j = 1 To UBound(ThisYear) '...compare it to each name in the original this year's list...
If ThisYear(j) = LastYear(i) Then MatchFound = True: Exit For
Next j

If Not MatchFound Then 'add the name to the new Last Year Only array:
LYOIndex = LYOIndex + 1
ReDim Preserve LastYearOnly(1 To LYOIndex)
LastYearOnly(LYOIndex) = LastYear(i)
End If
Next i
'put the arrays on the spreadsheet (I haven't bothered clearing what was there before)
Range("D4").Resize(LYOIndex) = Application.Transpose(LastYearOnly)
Range("E4").Resize(TYOIndex) = Application.Transpose(ThisYearOnly)
Range("F4").Resize(BYIndex) = Application.Transpose(BothYears)
End Sub[/vba]

[mdmackillop]

Why use the nested loop? 20k entries in both arrays would take a while.
[VBA]
For Each name1 In list1
On Error Resume Next
chk = Application.Match(name1, list2, 0)
If IsError(chk) Then
'add to array or whatever
Cells(Rows.Count, "D").End(xlUp).Offset(1) = name1
Else
'add to other array or whatever
Cells(Rows.Count, "F").End(xlUp).Offset(1) = name1
End If
Next name1
[/VBA]