faster way to loop through two sheets of 10000+ rows - excel

Question

This module goes through each cell in column a in sheet 2, and checks it with every cell in colmumn b in sheet2, if it matchs the "matches number" increases and is placed in a cell im sheet3. the ammount of data is huge and the module keeps on crashing, is there abetter way of doing this (maybe access, or a more efficient VBA module). Please note that I need to know the number of matches for each cell alone and not the total number of repetition.
Thanks in advance fellas!
Sub findpatterns()
Application.ScreenUpdating = False
Dim RowCount1 As Long, ClmnCount1 As Long
Dim RowCount2 As Long, ClmnCount2 As Long
Dim Crntrow As Long, Lastrow As Long
Dim Crntrow1 As Long, LastRow1 As Long
Dim Recordrow As Long
Recordrow = 1
RowCount1 = Sheets("sheet1").Cells(Rows.Count, "a").End(xlUp).Row
ClmnCount1 = Sheets("sheet1").Cells(1, Columns.Count).End(xlToLeft).Column
RowCount2 = Sheets("sheet2").Cells(Rows.Count, "a").End(xlUp).Row
ClmnCount2 = Sheets("sheet2").Cells(1, Columns.Count).End(xlToLeft).Column
Lastrow = RowCount1
LastRow1 = RowCount2
Crntrow1 = 1
Crntrow = 1
For Crntrow1 = 1 To LastRow1
'MsgBox "first loop is running"
For Crntrow = 1 To Lastrow
'MsgBox "second loop is running"
If (Sheets("sheet2").Cells(Crntrow1, "a").Value = Sheets("sheet1").Cells(Crntrow, "b").Value Or Sheets("sheet1").Cells(Crntrow, "b").Value = Sheets("sheet2").Cells(Crntrow1, "b").Value) And Not Sheets("sheet2").Cells(Crntrow1, "a").Value = "" Then
Sheets("sheet3").Cells(Crntrow1, "b").Value = Sheets("sheet3").Cells(Crntrow1, "b").Value + 1
'Sheets("sheet3").Cells(Crntrow1, "c").Value = Sheets("sheet2").Cells(Crntrow1, "g").Value
'MsgBox Material
Else
'MsgBox "no matches found"
End If
Next Crntrow
Next Crntrow1
End Sub

Answer 1

First off just a few comments on your code as it is not real easy to read.
You can get rid of some variables, ClmnCount(1,2) aren't used
RowCount(1,2) are only used to pass values directly to Lastrow so you don't really need them
By passing RowCount1>LastRow and RowCount2>LastRow1 you make it more confusing try to keep your numbering scheme consistant
It looks like you basically want a countif statement like this
=IF(Sheet2!A1="",0,COUNTIF(Sheet1!$B$1:$B$10000,Sheet2!A1)+COUNTIF(Sheet1!$B$1:$B$10000,Sheet2!B1))
Which counts the number of occurances in Sheet1 column B that match sheet2 A1 or B1 and does this for each row in column 2 (as long as sheet2 A1 has data in it).
By using this formula in a macro you can avoid the loop using something like the following. Which uses the formula, fills it down for all the rows you need and then copies the values over the formulas to freeze it. This should be a fair bit quicker then your double loop.
Sub findpatterns()
Dim LastRow1 As Long
Dim LastRow2 As Long
Application.ScreenUpdating = False
LastRow1 = Sheets("sheet1").Cells(Rows.Count, "a").End(xlUp).Row
LastRow2 = Sheets("sheet2").Cells(Rows.Count, "a").End(xlUp).Row
Sheets("sheet3").Range("A1").Formula = "=IF(Sheet2!A1="""",0,COUNTIF(Sheet1!$B$1:$B$" & LastRow1 & ",Sheet2!A1)+COUNTIF(Sheet1!$B$1:$B$" & LastRow1 & ",Sheet2!B1))"
Sheets("sheet3").Range("A1").AutoFill Destination:=Sheets("sheet3").Range("A1:A" & LastRow2)
Calculate
Sheets("sheet3").Range("A1:A" & LastRow2).Value = Sheets("sheet3").Range("A1:A" & LastRow2).Value
Application.ScreenUpdating = True
End Sub

Answer 2

When you have data that is this large and if it has many columns also, you may want to consider using a database (MSAccess, SQLServer etc).
That said, there are ways to speed up your code also. Excel objects like Cells, Ranges, Sheets etc are heavy with data about the size, color, borders, fill font etc that you don't likely need. Try using a variant to store the data ONLY like this:
Let the variable LastCol represent the last column in the data.
Dim myData as Variant
myData = Range(Sheets("Sheet2").Cells(1, 1), Sheets("Sheet2").Cells(LastRow, LastCol))
Note that I did NOT use the Set keyword. This will return the default value for the Range object (which is a variant containing only the data.
Now iterating: For i = LBound(myData, 1) to UBound(MyData, 1) should be faster.