Copy paste information with matching IDs that has more than 100000 rows in each sheet within Workbook

Question

Hello Currently I have code that is able to run and do a match within 2 sheets and copy paste the information from "sheet 2" to "sheet 1" when both IDs match.

However, I have more than 100000 rows on each sheet. Thus, when I run the code it keeps running. I tried the code for less than 1000 rows and it works after it runs for 3-4 Minutes. However when I tried to run for 100000 rows, it keeps running.

I hope someone can help me perhaps to improve my code to allow it to run for more than 100000 rows. This is the code that I have:

Sub AAA()


  Dim tracker As Worksheet
    Dim master As Worksheet
    Dim cell As Range
    Dim cellFound As Range
    Dim OutPut As Integer

   Set tracker = Workbooks("test.xlsm").Sheets("Sheet1")
   Set master = Workbooks("test.xlsm").Sheets("Sheet2")


    For Each cell In master.Range("A2:A100000")

        Set cellFound = tracker.Range("A5:A43000").Find(What:=cell.Value, LookIn:=xlValues, LookAt:=xlWhole)
        If Not cellFound Is Nothing Then

            cellFound.Offset(ColumnOffset:=1).Value2 = cell.Offset(ColumnOffset:=2).Value2

        Else

        End If
        Set cellFound = Nothing
        Debug.Print cell.Address
    Next
    OutPut = MsgBox("Update over!", vbOKOnly, "Update Status")


End Sub

Any help would be much appreciated. Thank you!:)

You need to take time to read and understand the answer to your previous question whichh address pretty much exactly the same issue. It provides an answer using VBA dictionaries that could be adapted to do what you want. I think you would be best off using the query solution I suggested below though. Your other question is here: http://stackoverflow.com/questions/32470855/run-through-a-loop-for-more-than-100-000-rows-of-data-in-two-sheets-in-the-same/32472168#comment52844327_32472168 — HarveyFrench, Sep 10 '15 at 09:31

Ashwith Ullal · Answer 1 · 2015-09-09T09:54:29.023

1

Sub compare_sheet1_with_sheet2()  
For i = 1 To 100000
For j = 1 To 100000

If Worksheets("sheet1").Range("A" & i).Value = Worksheets("sheet2").Range("A" & j).Value Then


Worksheets("sheet2").Range("A" & i & ":P" & i).Select

With Selection.Interior
    .Pattern = xlSolid
    .PatternColorIndex = xlAutomatic
    .ThemeColor = xlThemeColorDark1
    .TintAndShade = 0
  .PatternTintAndShade = 0
End With

End If
Next j
Next i
end sub

edited Sep 09 '15 at 09:54

answered Sep 07 '15 at 11:15

Ashwith Ullal

263
3
10

Hi, i tried the code you gave but it does not run at all when i run it @AshwithUllal – nabilah Sep 09 '15 at 06:17
When i press run, the code does not run at all @AshwithUllal – nabilah Sep 10 '15 at 02:16

score 0 · Answer 2 · answered Sep 07 '15 at 09:06

0

Option 1: Optimize VBA:

ScreenUpdating = False
Turn off AutomaticUpdating
etc.

See more tips here.

Option 2: MS Query

How bout a quick MS Query?:

SELECT S1.COLUMN_A, Iif(S2.COLUMN_A IS NULL, S1.COLUMN_B, S2.COLUMN_C) FROM
[Sheet1$] as S1 LEFT JOIN [Sheet2$] as S2 ON S1.COLUMN_A = S2.COLUMN_A

Replace the COLUMN_X with the right column headers.

Feel free to use my SQL AddIn or go to Excel and select DATA->From Other Sources->From Microsoft Query

answered Sep 07 '15 at 09:06

AnalystCave.com

4,884
2
22
30

Interesting idea: what's the VBA code to get the above query into a cell or range? Do you generate a query table for that? What kind of SQL syntax is supported by MS Queries? It doesn't seem to be ANSI standard with `Iif` in the syntax. – Ralph Sep 07 '15 at 13:54
It's an OleDB query (MS Access type SQL) - supported across all MS Office applications. To generate the VBA just click `Record Macro` and create a MS Query as I mentioned above. This will generate the VBA. – AnalystCave.com Sep 07 '15 at 13:57

score 0 · Answer 3 · answered Sep 10 '15 at 09:17

The AnalystCave.com addin mentioned is essentially a wizard to create Querytables, which are a standard excel feature. Once created the QueryTable is saved with the workbook and the addin is no longer needed.

Excel also provides the user a way to create these QueryTables (without using VBA) but the process is horrible.

Having just used the addin, I would recommend using it, and recommend not writing your own VBA code to create the QueryTable for yourself (as it's time consuming). However if you do want to create them using VBA here is some code to start you off.

Note that an alternative is to use MS PowerQuery, but for simple stuff the addin is much easier and quicker than power query (well done Microsoft, but the addin author wins this round)

Sub CreateAQueryConnection()

Dim wks As Worksheet
Dim MyConnection  As String
Dim qt As QueryTable


Set wks = ActiveSheet

'Clear worksheet of old QueryTables
For Each qt In wks.QueryTables
    qt.Delete
Next qt

' Build a connection string using http://www.connectionstrings.com/excel/
' (The one below is overkill!)

MyConnection = Join(Array( _
"OLEDB;Provider=Microsoft.ACE.OLEDB.12.0;User ID=Admin;Data Source=C:\Users\Harvey\OneDrive\My Study\Excel Study\SQL Addin1.xlsx;Mode=S" _
, "hare Deny Write;Extended Properties=""Excel 12.0 Xml;HDR=YES"";Jet OLEDB:System database="""";Jet OLEDB:Registry Path="""";Jet OLEDB:E" _
, "ngine Type=35;Jet OLEDB:Database Locking Mode=0;Jet OLEDB:Global Partial Bulk Ops=2;Jet OLEDB:Global Bulk Transactions=1;Jet OLE" _
, "DB:New Database Password="""";Jet OLEDB:Create System Database=False;Jet OLEDB:Encrypt Database=False;Jet OLEDB:Don't Copy Locale " _
, "on Compact=False;Jet OLEDB:Compact Without Replica Repair=False;Jet OLEDB:SFP=False;Jet OLEDB:Support Complex Data=False;Jet OLE" _
, "DB:Bypass UserInfo Validation=False;Jet OLEDB:Limited DB Caching=False;Jet OLEDB:Bypass ChoiceField Validation=False" _
), "")

'Check if querytable exists
If wks.QueryTables.Count > 0 Then
    Set qt = wks.QueryTables("qt" & wks.codename)
Else

    Set qt = wks.QueryTables.Add(Connection:=MyConnection, Destination:=wks.Cells(1, 1))

End If

With qt


    .CommandType = xlCmdSql

    ' Yuo will need to chnage the sql that you use
    .CommandText = Array("SELECT T1.* FROM [Sheet1$] AS T1")


    ' you could set the name here - it's done already
    ' .Name = ""

    .FieldNames = True
    .RowNumbers = False
    .AdjustColumnWidth = True
    .FillAdjacentFormulas = True
    .PreserveFormatting = True
    .PreserveColumnInfo = False

    .SavePassword = False
    .SaveData = True

    .RefreshOnFileOpen = True
    .BackgroundQuery = True
    .RefreshStyle = xlOverwriteCells
    .RefreshPeriod = 60

    .Refresh BackgroundQuery:=False

End With

' Set ExecuteSQL = qt.ResultRange
Debug.Print qt.ResultRange.Address

End Sub

Hi i am not encourage to use any SQL because my supervisor would prefer a macro VBA coding or excel functions to be used instead @HarveyFrench — nabilah, Sep 10 '15 at 09:19
I would try using SQL, show it to your supervisor and see what he says! — HarveyFrench, Sep 10 '15 at 09:32

Copy paste information with matching IDs that has more than 100000 rows in each sheet within Workbook

3 Answers3

Option 1: Optimize VBA:

Option 2: MS Query