VBA Macro Speed Up - vba

Question

I would appreciate some help on the following VBA Macro problem,
screenshot here:
I have to compare the data in 2 columns - Index & Sec_Index. In case of a match it should check which Values is assigned to the Sec_Index and fill a "1" to the matching Value column corresponding to Index and "0" for the other Value columns (I hope the screenshot explains it better)
I wrote a short macro which works good. However I have huge amounts of data - both Index columns contain at least 400000-500000 lines. This makes my code useless since it will take extreme long durations to execute.
Is there a way to make this work? I read about Variant arrays, but I'm not that familiar with them.

Answer 1

You can put this formula (if Excel 2007 or above):
=COUNTIFS($H$2:$H$5,$B2,$I$2:$I$5,"A")
into C2 and copy it down and across; just change "A" to "B" and "C".
Added In view of the number of rows, I would import the data into MS Access, create a Crosstab Query, then copy this data back to Excel.

Answer 2

Try this, not overly robust but does work. Not sure how quickly this will compare to what you may have had?
It did about 60,000 rows with 25 keys in about 5 seconds.
Edit: Added timer to function.
Public Declare Function GetTickCount Lib "kernel32.dll" () As Long
public Sub main()
Dim t As Long
t = GetTickCount
Application.ScreenUpdating = False
Dim Arr1(), Arr() As Double
Dim x, y, i, j As Double
Dim v As String
x = Cells(Rows.Count, 2).End(xlUp).Row - 2
y = Cells(Rows.Count, 8).End(xlUp).Row - 2
Range("c2", "e" & x + 2) = 0
ReDim Arr1(x)
ReDim Arr2(y)
i = 0
Do Until Cells(i + 2, 2) = ""
Arr1(i) = Cells(i + 2, 2)
i = i + 1
Loop
i = 0
Do Until Cells(i + 2, 8) = ""
Arr2(i) = Cells(i + 2, 2)
i = i + 1
Loop
i = 0
Do Until i > UBound(Arr1)
j = 0
Do Until j > UBound(Arr2)
If Arr1(i) = Arr2(j) Then
v = Cells(Arr2(j) + 1, 9)
Select Case v
Case "a"
Cells(i + 2, 3) = 1
Case "b"
Cells(i + 2, 4) = 1
Case "c"
Cells(i + 2, 5) = 1
End Select
Exit Do
End If
j = j + 1
Loop
i = i + 1
Loop
MsgBox GetTickCount - t, , "Milliseconds"
End Sub