Compare 2 arrays in VBA and write to another sheet - vba

Question

I have 2 excel sheets and i have to compare some values,this is the easy part. For this i used the following code :
Dim OldLabel() As String, size As Integer, i As Integer, j As Integer
size = WorksheetFunction.CountA(Worksheets(3).Columns(1))
ReDim OldLabel(size)
j = 1
For i = 7 To size
If (InStr(Cells(i, 1).Value, "[") > 0) Then
OldLabel(j) = Cells(i, 1).Value
j = j + 1
End If
Next i
Dim NewLabel() As String, newSize As Integer, k As Integer, l As Integer
newSize = WorksheetFunction.CountA(Worksheets(4).Columns(1))
ReDim NewLabel(newSize)
l = 1
For k = 7 To newSize
If (InStr(Cells(k, 1).Value, "[") > 0) Then
NewLabel(l) = Cells(k, 1).Value
l = l + 1
End If
Next k
After that i have to compare the values of the two arrays and check if they are the same and write them to another sheet. I have tried to following code but it doesn't seem to be working.
Dim cont As Integer
cont = 1
For i = 1 To size
For k = 1 To newSize
If (OldLabel(i) = NewLabel(k)) Then
Sheet8.Activate
Range("A1").Select
Cells(cont, 1).Value = OldLabel(i)
cont = cont + 1
End If
Next k
Next i

Answer 1

This is one of the cases I recommend the use of data collections instead of arrays:
'Define data collections:
Dim OldLabel As New Collection: Set OldLabel = New Collection
Dim NewLabel As New Collection: Set NewLabel = New Collection
'Define data limits:
Dim OldLimit As Integer
OldLimit = ThisWorkbook.Sheets("Sheet3").Columns(1).Find("*", SearchOrder:=xlByRows, LookIn:=xlValues, SearchDirection:=xlPrevious).Row
Dim NewLimit As Integer
NewLimit = ThisWorkbook.Sheets("Sheet4").Columns(1).Find("*", SearchOrder:=xlByRows, LookIn:=xlValues, SearchDirection:=xlPrevious).Row
'Define extra variables:
Dim counter As Integer
counter = 1
'Fill collections:
For x = 1 To OldLimit
If InStr(ThisWorkbook.Sheets("Sheet3").Cells(x, 1).text, "[") > 0 Then
OldLabel.Add ThisWorkbook.Sheets("Sheet3").Cells(x, 1).text
End If
Next x
For x = 1 To NewLimit
If InStr(ThisWorkbook.Sheets("Sheet4").Cells(x, 1).text, "[") > 0 Then
NewLabel.Add ThisWorkbook.Sheets("Sheet4").Cells(x, 1).text
End If
Next x
'Writer:
If OldLabel.Count > 0 And NewLabel.Count > 0 Then
For x = 1 To OldLabel.Count
For y = 1 To NewLabel.Count
If OldLabel(x) = NewLabel(y) Then
ThisWorkbook.Sheets("Sheet8").Cells(counter, 1).FormulaR1C1 = OldLabel(x)
counter = counter + 1
End If
Next y
Next x
End If
Please note: a) You don't have to activate worksheets for your procedure; b) I named the worksheets and used that name to reference them; for some reasons, I prefer don't use sheets indexes; c) Check the fact you're only comparing cells with the "[" character in them; d) If any of the data columns is empty, the code will produce an error.