VBA Optimizing macro loop - vba

Question

The scenario is that I have 40 sheets and there can be up to ~5k rows in each sheet so I'm dealing with a lot of data which is causing this macro to run extremely slow. For example the first sheet alone has around 15219162 computations which only has about 380 rows. Is there a way to trim down the amount of computations my macro has to run?
There is 39326 unqiue twitter names so far which means 39326 x 387 rows in the first page.
Sub CountInvestorsByTwitterName()
With Application
.Calculation = xlCalculationManual: .ScreenUpdating = False: .DisplayAlerts = False
End With
Dim row_total As Long
Dim Unique_Values_Sheet As Worksheet
Set Unique_Values_Sheet = Sheets(Sheets.Count)
Unique_Values_Sheet.Columns("B:XFD").EntireColumn.Delete
Dim Unique_Values_Sheet_row_total As Long
Unique_Values_Sheet_row_total = Unique_Values_Sheet.Cells(Rows.Count, "A").End(xlUp).Row
Dim Unqiue_Twitter_Names As Range
Set Unqiue_Twitter_Names = Unique_Values_Sheet.Range("A2:A" & Unique_Values_Sheet_row_total).Cells
For Each s In Sheets
If s.Name <> "UNIQUE_DATA" Then
row_total = s.Cells(Rows.Count, "B").End(xlUp).Row
For Each r In s.Range("B2:B" & row_total).Cells
Twitter_Name = r.Value
For Each c In Unqiue_Twitter_Names
If c.Value = Twitter_Name Then
With c
.Offset(0, 1).Value = CDbl(.Offset(0, 1).Value) + 1
.End(xlToRight).Offset(0, 1).Value = s.Name
End With
End If
Next
Next
End If
' Loop through first sheet
' Exit For
Next
With Application
.Calculation = xlCalculationAutomatic: .ScreenUpdating = True: .DisplayAlerts = True
End With
End Sub

Answer 1

try this
Option Explicit
Sub CountInvestorsByTwitterName2()
Dim row_total As Long
Dim Unqiue_Twitter_Names As Range
Dim found As Range
Dim sht As Worksheet
Dim r As Range, shtRng As Range
With Application
.Calculation = xlCalculationManual: .ScreenUpdating = False: .DisplayAlerts = False
End With
With Sheets("UNIQUE_DATA")
.Columns("B:XFD").EntireColumn.Delete
Set Unqiue_Twitter_Names = .Range("A2:A" & .Cells(.Rows.Count, "A").End(xlUp).Row).SpecialCells(xlCellTypeConstants, xlTextValues)
End With
For Each sht In Sheets
With sht
If .Name <> "UNIQUE_DATA" Then
Set shtRng = .Range("B2:B" & .Cells(.Rows.Count, "B").End(xlUp).Row).SpecialCells(xlCellTypeConstants, xlTextValues)
For Each r In shtRng
Set found = Unqiue_Twitter_Names.Find(What:=r.Value, LookIn:=xlValues, LookAt:=xlWhole)
If Not found Is Nothing Then
With found
.Offset(0, 1).Value = CDbl(.Offset(0, 1).Value) + 1
.End(xlToRight).Offset(0, 1).Value = sht.Name
End With
End If
Next
End If
End With
Next
With Application
.Calculation = xlCalculationAutomatic: .ScreenUpdating = True: .DisplayAlerts = True
End With
End Sub
if not sufficiently fast, you could try some "array" approach, storing relevant sheet cells values in a array and performing searching with them
also a Dictionary approach could be worth examinating

Answer 2

What I would do:
1) Clear the entire 'UNIQUE_DATA' sheet.
2) Loop through all worksheets, and if the name of the sheet isn't 'UNIQUE DATA', copy all rows with content to 'UNIQUE_DATA' (copy-paste rows, after detecting beforehand which rows, and at which lines to insert them)
3) Sort all rows in 'UNIQUE DATA' on the column containing the twitter handles. Macro code is easy to figure out if you macro-record it once.
4) Loop through all rows in sheet 'UNIQUE_DATA', and compare value of Twitter handle with the Twitter handle for the row below. If they match, delete the next row (and lower the upper bound of your loop counter).
You should end up with all unique Twitter handles.
I do have to agree the last step may take some time. But at least doing this is a complexity of O(n) rather then O(n²) you currently have with two nested loops. Especially for high values of n, the time difference should be significant.