VBA Code Efficiency Help!

[MattH1]

Hey everyone,
I have a code that runs fine but is taking longer than I would like. I was wondering if there is any way to make this code more efficient, particularly in the formula and application of it to nearly 250,000 rows

Would ScreenUpdating really be THAT large of a change? I know I can add it to the code (and will once I know it runs smoothly while watching), but I don't think it'll take off as much time as I would like.

Function ConvertToLetter(iCol As Integer) As String
   Dim iAlpha As Integer
   Dim iRemainder As Integer
   iAlpha = Int(iCol / 27)
   iRemainder = iCol - (iAlpha * 26)
   If iAlpha > 0 Then
      ConvertToLetter = Chr(iAlpha + 64)
   End If
   If iRemainder > 0 Then
      ConvertToLetter = ConvertToLetter & Chr(iRemainder + 64)
   End If
End Function




Sub DataMerge()
Dim StartTime, Endtime As Double
StartTime = Now()

'Establish Global Variables and Workbook/Worksheet Information
Dim Worksheet As Integer
Dim TabName As String
Dim WorkBoookName As String
Dim RowCount As Long
Dim ColumnCount As Long
'Establish Workbook Name
WorkbookName = ActiveWorkbook.Name
'Establish Main Worksheet Name

'Counts the number of rows within TabName
TabName = ActiveSheet.Name
RowCount = ActiveSheet.Cells(ActiveSheet.Rows.Count, "A").End(xlUp).Row
ColumnCount = Sheets(TabName).Cells(1, Columns.Count).End(xlToLeft).Column

'Finding ID1 to use for INDEX/MATCH FORMULA
Dim FindID1 Range
With Sheets(TabName)
    Set FindID1= .Cells.Find(What:="ID1 Text")
End With

'FileIsOpen:
'Move to ALERT_DETAILS file to find column letters
Windows("Sheet2.xlsx").Activate
Dim FindID2As Range
With Sheets("ID_DETAILS")
    Set FindID2= .Cells.Find(What:="ID2 Text")
End With
Dim FindID3 As Range
With Sheets("Sheet2.xlsx)
    Set FindAlert = .Cells.Find(What:="ID3 Text")
End With
Dim FindID4 As Range
With Sheets("Sheet2.xlsx")
    Set FindID4 = .Cells.Find(What:="ID4 Text")
End With

ID1Column = ConvertToLetter(FindID1.Column)
ID2Column = ConvertToLetter(FindID2.Column)
ID3Column = ConvertToLetter(FindID3.Column)
ID4Column = ConvertToLetter(FindID4.Column)

Windows(WorkbookName).Activate
With Sheets(TabName)
    .Range("A2:A" & RowCount).Offset(, ColumnCount).Formula = "=INDEX(Sheet2.xlsx!$" & ID4Column & ":$" & ID4Column & ",MATCH($" & ID1Column & 2 & ", Sheet2.xlsx!$" & ID3Column & ":$" & ID3Column & ",0))"
    .Range("A2:A" & RowCount).Offset(, ColumnCount + 1).Formula = "=INDEX(Sheet2.xlsx!$" & ID2Column & ":$" & ID2Column & ",MATCH($" & ID1Column & 2 & ", Sheet2xlsx!$" & ID3Column & ":$" & ID3Column & ",0))"
End With

 

Endtime = Now()
MsgBox "Your code took " & (DateDiff("s", StartTime, Endtime)) & " seconds!"

EndSub

The problem is that the RowCount is 250,000 cells. And the formula takes roughly .0055 seconds per cell calculated (give or take a miniscule amount) and therefore this entire macro takes nearly 45 minutes (to an hour) to run. I was hoping to get it down somewhere near 30-35 minutes. Any tips are appreciated!

 

[MattH1]

I tried this code:

.Range("A2:A5000").Offset(, ColumnCount).FormulaR1C1 = "=MATCH(" & ID1Column& "2, Sheet2.xlsx!" & ID3Column & ":" & ID3Column & ",0)"

It returned this:
=MATCH($B:$B, Sheet2.xlsx!AA),0)
This is wrong because it should be Column C and A:A should just be A:A, not AA) and I don't know what's causing it.

EDIT:

Not in the code I posted they aren't since I removed the calls to those functions.

I didn't even notice that, I'll try it again thanks!

 

[MattH1]

That worked Rory, I'll be trying it with the full code now to see if it speeds up the process at all!

 

[RoryA]

Did you not simply try the code as I posted it?

 

[MattH1]

Did you not simply try the code as I posted it?

I had just input the With statement but didn't notice you didn't reference my Function, so I went and changed it to fully use your code. It seemed to run quite well, I'm testing it now for speed against past results and hoping it'll be shorter. Do you think it'll speed it up by much? My last run was nearly 50 minutes which is not ideal, anything near 40 would be better.

 

[RoryA]

Hard to say. I would expect that loading the data from Sheet2 into a Dictionary full of arrays will be the fastest but you won't end up with live formulas, which appeared to be an end goal of your code.

If you can sort the data on sheet 2 by the match column, you could speed it up significantly.

 

[MattH1]

Hard to say. I would expect that loading the data from Sheet2 into a Dictionary full of arrays will be the fastest but you won't end up with live formulas, which appeared to be an end goal of your code.

If you can sort the data on sheet 2 by the match column, you could speed it up significantly.

That's what Calc had tried doing, though there seemed to be a problem that I can't understand enough to fix (given my lack of knowledge with Dictionaries and Arrays, though I'm reading up on them right now in hopes of finding a solution).

 

[MattH1]

Rory I'm going to run it again because I can't believe this to be true but it cut it down to like 10 minutes...
If I were to use this method (after it running successfully 1-2 more times), what is the most efficient way to remove that column after and re-paste those INDEX formulas as values (so that they don't get erased or #N/A when I remove the MATCH column that was created)?

E: I also noted that you said "live formulas" seemed to be a goal. I just need the VALUES from these index/match functions on that sheet, the formula is less important so long as the result is the same. And as a value is preferred so that I don't have to worry about another user copying over the formula accidentally and re-evaluating the equations with an incorrect reference.

 

[RoryA]

Change the end bit to this:

With currentWB.ActiveSheet
    .Range("A2:A" & RowCount).Offset(, ColumnCount + 2).FormulaR1C1 = "=MATCH(RC" & ID1Column & ", Sheet2.xlsx!C" & ID3Column & ",0)"
    With .Range("A2:A" & RowCount).Offset(, ColumnCount)
        .FormulaR1C1 = "=INDEX(Sheet2.xlsx!C" & ID4Column & ",RC[2])"
        .Value2 = .Value2
    End With
    With .Range("A2:A" & RowCount).Offset(, ColumnCount + 1)
        .FormulaR1C1 = "=INDEX(Sheet2.xlsx!C" & ID2Column & ",RC[1])"
        .Value2 = .Value2
    End With
    .Range("A2:A" & RowCount).Offset(, ColumnCount + 2).Clear
End With

 

[MattH1]

Change the end bit to this:

With currentWB.ActiveSheet
    .Range("A2:A" & RowCount).Offset(, ColumnCount + 2).FormulaR1C1 = "=MATCH(RC" & ID1Column & ", Sheet2.xlsx!C" & ID3Column & ",0)"
    With .Range("A2:A" & RowCount).Offset(, ColumnCount)
        .FormulaR1C1 = "=INDEX(Sheet2.xlsx!C" & ID4Column & ",RC[2])"
        .Value2 = .Value2
    End With
    With .Range("A2:A" & RowCount).Offset(, ColumnCount + 1)
        .FormulaR1C1 = "=INDEX(Sheet2.xlsx!C" & ID2Column & ",RC[1])"
        .Value2 = .Value2
    End With
    .Range("A2:A" & RowCount).Offset(, ColumnCount + 2).Clear
End With

Hey Rory thank you so much for following up and committing to helping me with this! The code is 20% done and seems to be working just fine. I'm curious why you use the command ".Value2 = .Value2". I know that this essentially stores it as a value, but why is the 2 added? Any and all input appreciated, thank you again!!