0

I am trying to perform a query on an excel worksheet like I have done many times, but now the data has over 70k rows. Normally, I get the message that it cannot find the table if this is the case, which is to be expected since I think it stops working at around 65k rows or so.

So, what I am trying instead is doing a loop where in the first part of the loop I run the first 60k rows, and in every iteration of the loop it does another batch of 60k until it finishes with the last set. The loop creates a new sheet with the data to work with so I can have the column headers with the data set. It seems to work all the way up to the part where it runs a new query on the data from the new sheet. It gives me the error that "The Microsoft Access database engine could not find the object " (My Table Name)... etc.

For my specific example the table is "Sheet1$A1:N12790" where 12790 is the leftover number of rows from the over 70k row sheet and Sheet1 is the sheet that is created when you run the code.

So, I have absolutely no clue why it is giving this error when it usually only does it if there are too many rows or if the table definitely does not exist.

I tried running a simple Select * from [Sheet1$A1:N12790] with a separate sub, and it works perfectly. This leads me to believe that somehow maybe excel is running out of memory perhaps after doing the first one? But I have no idea what to do about it, and there is very little information on the web about this since it is so specific and rare since most people just use a regular database at this point.

Thanks!

UPDATE: I have been testing many things. I have tried creating a test sub to handle the new sheet (as explained above) and it works when run separately, but if I try and force the main sub to exit the loop sooner and then call the new test sub to run what I want it to do, it gives me the same error. So again, both subs run separately perfectly but I can't use the one to call the other. Shows me more proof that it is less about the coding and more about some sort of processing complication, but I still am just putting out theories.

Update 2: Thank you for all of the ideas and suggestions up till now (6/20/18). Here is a screenshot of what the error says when it runs through the second time and tries to run MySQL:

Error Message:

Error Message

Here is my code below if it is helpful:

Sub Risk_Init_Pivot(FA_PQ, Risk_Init, SubChannel, MyMonth As String)

    Application.ScreenUpdating = False

    Dim SheetRange1 As Range, SheetRange2 As Range, SheetRange3 As Range, MyRange As Range
    Dim TargetSheetTable As String, SheetTable1 As String
    Dim SR1_LastRow As Double, SR1_LastColumn As Double, NewRowCount As Double, SR1_FirstRow As Double
    Dim i As Integer, j As Integer, MyLoop As Integer
    Dim Table1 As String, MySQL As String
    Dim MySheet1 As Worksheet, MySheet2 As Worksheet
    Dim MyConn As ADODB.Connection
    Dim MyRecordSet As ADODB.Recordset

    TargetSheetTable = "Risk Init Pivot"
    SheetTable1 = "Fanned File"

    'Initiate
    ActiveWorkbook.Sheets(TargetSheetTable).Activate

    If ActiveSheet.AutoFilterMode Then
        If ActiveSheet.FilterMode Then ActiveSheet.ShowAllData
    End If

    ActiveSheet.Cells.ClearContents

    'Find Range Coordinates Dynamically
    ActiveWorkbook.Sheets(SheetTable1).Activate

    If ActiveSheet.AutoFilterMode Then
        If ActiveSheet.FilterMode Then ActiveSheet.ShowAllData
    End If

    Range("A1").Select
    Selection.End(xlDown).Select
    SR1_LastRow = Selection.Row
    ActiveCell.SpecialCells(xlLastCell).Select
    SR1_LastColumn = Selection.Column
    Range("A1").Select

    MyLoop = WorksheetFunction.RoundUp(SR1_LastRow / 60000, 0)

    NewRowCount = 0

    For j = 1 To MyLoop

        'Set Up Connection Details
        Set MyConn = New ADODB.Connection
        MyConn.CommandTimeout = 0
        Set MyRecordSet = New ADODB.Recordset

        MyConn.Open "Provider = Microsoft.ACE.OLEDB.12.0;" & _
        "Data Source = " & Application.ThisWorkbook.FullName & ";" & _
        "Extended Properties = ""Excel 12.0 Xml;HDR=YES;IMEX=1"";"
        Set MyRecordSet.ActiveConnection = MyConn

        'First Time
        If SR1_LastRow > 60000 Then
            NewRowCount = SR1_LastRow - 60000
            SR1_LastRow = 60000
            SR1_FirstRow = 1

            'Set the tables equal to the respective ranges
            Set SheetRange1 = ActiveWorkbook.Sheets(SheetTable1).Range("A" & SR1_FirstRow & ":" & Cells(SR1_LastRow, SR1_LastColumn).Address)

            'Pass the table address to a string
            Table1 = SheetRange1.Address

            'Convert the string into a query table - have to get rid of dollar signs for it to work
            Table1 = "[" & SheetTable1 & "$" & Replace(Table1, "$", "") & "]"

        'Does this until NewRowCount falls into last time
        ElseIf NewRowCount > 60000 Then
            NewRowCount = NewRowCount - 60000
            SR1_FirstRow = SR1_LastRow + 1
            SR1_LastRow = SR1_LastRow + 60000

            Set MySheet1 = Sheets(SheetTable1)
            Sheets.Add After:=MySheet1
            Set MySheet2 = ActiveSheet

            MySheet1.Activate
            Rows("1:1").Select
            Selection.Copy
            MySheet2.Activate
            Rows("1:1").Select
            Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

            MySheet1.Activate
            ActiveSheet.Range("A" & SR1_FirstRow & ":" & Cells(SR1_LastRow, SR1_LastColumn).Address).Copy
            MySheet2.Activate
            ActiveSheet.Range("A2").PasteSpecial xlPasteValues
            Range("A1").Select
            Range(Selection, Selection.End(xlDown)).Select
            Range(Selection, Selection.End(xlToRight)).Select
            Set MyRange = Selection

            'Set the tables equal to the respective ranges
            Table1 = Selection.Address

            'Convert the string into a query table - have to get rid of dollar signs for it to work
            Table1 = "[" & MySheet2.Name & "$" & Replace(Table1, "$", "") & "]"

        'Last Time
        ElseIf (NewRowCount > 0) And (NewRowCount <= 60000) Then
            SR1_FirstRow = SR1_LastRow + 1
            SR1_LastRow = SR1_LastRow + NewRowCount
            NewRowCount = 0


            Set MySheet1 = Sheets(SheetTable1)
            Sheets.Add After:=MySheet1
            Set MySheet2 = ActiveSheet

            MySheet1.Activate
            Rows("1:1").Select
            Selection.Copy
            MySheet2.Activate
            Rows("1:1").Select
            Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

            MySheet1.Activate
            ActiveSheet.Range("A" & SR1_FirstRow & ":" & Cells(SR1_LastRow, SR1_LastColumn).Address).Copy
            MySheet2.Activate
            ActiveSheet.Range("A2").PasteSpecial xlPasteValues
            Range("A1").Select
            Range(Selection, Selection.End(xlDown)).Select
            Range(Selection, Selection.End(xlToRight)).Select

            'Set the tables equal to the respective ranges
            Table1 = Selection.Address

            'Convert the string into a query table - have to get rid of dollar signs for it to work
            Table1 = "[" & MySheet2.Name & "$" & Replace(Table1, "$", "") & "]"

        'Does this the first time if under 60k rows
        Else
            SR1_FirstRow = 1

            'Set the tables equal to the respective ranges
            Set SheetRange1 = ActiveWorkbook.Sheets(SheetTable1).Range("A" & SR1_FirstRow & ":" & Cells(SR1_LastRow, SR1_LastColumn).Address)

            'Pass the table address to a string
            Table1 = SheetRange1.Address

            'Convert the string into a query table - have to get rid of dollar signs for it to work
            Table1 = "[" & SheetTable1 & "$" & Replace(Table1, "$", "") & "]"

        End If

        'SQL Statement
        MySQL = Sheets("Control Sheet").Range("C14").Value          
        MySQL = Replace(MySQL, "@Table1", Table1)           
        MySQL = Replace(MySQL, "@Year", Sheets("Control Sheet").Range("C5").Value)          
        MySQL = Replace(MySQL, "@FA_PQ_Input", FA_PQ)           
        MySQL = Replace(MySQL, "@SubChannel", SubChannel)           
        MySQL = Replace(MySQL, "@MyMonth", MyMonth)

        MsgBox MySQL

        'Run SQL
        MyRecordSet.Open MySQL, MyConn, adOpenKeyset, adLockOptimistic

        'Paste Data with headers to location
        ActiveWorkbook.Sheets(TargetSheetTable).Activate
        ActiveSheet.Range("A" & 1 + SR1_FirstRow).CopyFromRecordset MyRecordSet

        For i = 0 To MyRecordSet.Fields.Count - 1
            ActiveSheet.Cells(1, i + 1) = MyRecordSet.Fields(i).Name
            With ActiveSheet.Cells(1, i + 1)
                .Font.Bold = True
                .Font.Size = 10
            End With
        Next i

        MyRecordSet.Close
        Set MyRecordSet = Nothing

        MyConn.Close
        Set MyConn = Nothing
    Next j

    ''Putting Nulls in the blanks
    'ActiveSheet.Cells.Replace What:="", Replacement:="NULL", LookAt:=xlWhole, SearchOrder:=xlByRows, MatchCase:=True, _
    '                          SearchFormat:=False, ReplaceFormat:=False

    'Tidying the sheet
    ActiveSheet.Cells.AutoFilter                
    ActiveSheet.Columns.AutoFit
    ActiveSheet.Range("A1").Select              
    Sheets("Control Sheet").Activate

    Application.ScreenUpdating = True
End Sub
Xabier
  • 7,587
  • 1
  • 8
  • 20
Rick W.
  • 17
  • 5
  • The first things that stands out is that you declared your variables as Intergers, I'm pretty sure these should be declared as Long instead, as Integers can't hold values larger than around 32k... – Xabier Jun 19 '18 at 16:25
  • @Xabier I get what you mean, but if you look closer you will see that the variables set as integers are not holding super huge values. In fact the ones that are are declared as double and seem to be doing just fine in all of my other queries. Like I tried to mention in the above post, this works perfectly when the sheet has less than 65k rows or so... – Rick W. Jun 19 '18 at 16:53
  • To avoid the [XY Problem](https://meta.stackexchange.com/questions/66377/what-is-the-xy-problem) and mining through this voluminous amount of code, please give us the full background with data samples of input and desired output. – Parfait Jun 19 '18 at 18:51
  • Also, consider using an actual database. Do note: [Excel is not a database](https://www.google.com/search?q=Excel+is+not+a+database). And yes, you have MS Access available (i.e., its engine) though you may have the installed .exe program (which is really just the GUI console to engine). So you can [create and use Access databases](https://stackoverflow.com/a/39713289/1422451). – Parfait Jun 19 '18 at 18:51
  • The VBA is definitely in a code module and not a code worksheet? – Alan Jun 19 '18 at 18:58
  • Also, as alluded to by Parfait, have you considered moving the function to Access and then calling the function from Excel rather than querying the data directly? – Alan Jun 19 '18 at 19:00
  • Most likely, one or more of your operations is working on the wrong sheet or range, which is very hard to follow with all those `Select`s and `Activate`s. My advise: get rid of them. [See here for some help with that](https://stackoverflow.com/q/10714251/445425) you will probably find the error youself then. If not, update the Q code here sans `Select` and `Activate` – chris neilsen Jun 19 '18 at 21:38
  • @Parfait I know excel is not a database... The user is very attached to excel, and they take an excel file and transition it with many vlookups off countless sheets to tidy their data and produce a pivot. I simply am trying to reduce the time of their efforts. As far as what you are saying about "XY", I gave the background and only supplemented the code as needed. I want to be able to query a worksheet that has more than 65k rows and am looking for a solution that works within excel, but I explained that above. – Rick W. Jun 20 '18 at 01:28
  • @Alan, Definitely in a module .I could try and move it from excel to access and back to excel for the user, but that all seems to be a bit much in my head. Perhaps there are links to posts that simplify this process? – Rick W. Jun 20 '18 at 01:32
  • @Chris Neilsen, I am definitely on the correct sheet. I take a lot of care when designing my code around where it is executing. When I output the query to text that I can check, it is always pulling from the sheet that is expected. Again I will re-iterate that this code runs perfectly when less that 65k rows. – Rick W. Jun 20 '18 at 01:32
  • @Rick use of Select and Activate as you do here is, in my opinion, incompatible with "taking a lot of care". We see a lot of Qs using those that are easily solved once they are removed. You came to SO for help solving your problem, if you want to ignore the advise given, that's up to you. – chris neilsen Jun 20 '18 at 01:52
  • The fact that it runs OK when less than 65k rows suggests an error in the middle or final block. I would suggest breaking your code up into different functions. This would allow you to test each component separately. E.g. the database call should be in it's own subroutine and then you can test it is fetching values over 65k independently of anything else. This will allow you to narrow down where the issue is. Database calls can be expensive but 65k rows isn't necessarily a lot if you are using 64-bit Excel. – Alan Jun 20 '18 at 02:30
  • And if it was out of memory, Excel should give you message saying it is out of memory. I've seen the pop-up before on 32-bit Excel. I've seen unconfirmed comments that if you tell Excel to save the file at the end of each loop, then it will release all working memory - this may help if you are on 32-bit. – Alan Jun 20 '18 at 02:36
  • @chrisneilsen see below where someone did exactly what you are saying, and it did not change the result. I was not trying to ignore your advice, I was only trying to get a solution. I was just trying to let you know that I was on the right sheet and what you were saying was not the solution. Thanks for your time. – Rick W. Jun 20 '18 at 13:42
  • @Alan good thoughts, and I agree with your logic and I will try and process it to see if I can find an issue. As for trying to save it at the end of a loop, that sadly did not do work. – Rick W. Jun 20 '18 at 13:43

4 Answers4

2

I believe there are a number of issues with your code, and this is not necessarily an answer to your issue, but I have attempted to tidy your code and remove all the Select & Activate statements as they are not really needed and would sometimes cause errors when you have other Sheets activated and etc.

Please have a look at the code below, and hopefully you might get some pointers:

Sub Risk_Init_Pivot(FA_PQ, Risk_Init, SubChannel, MyMonth As String)

    Application.ScreenUpdating = False

    Dim SheetRange1 As Range, SheetRange2 As Range, SheetRange3 As Range, MyRange As Range
    Dim SR1_LastRow As Double, SR1_LastColumn As Double, NewRowCount As Double, SR1_FirstRow As Double
    Dim i As Long, j As Long, MyLoop As Long
    Dim Table1 As String, MySQL As String
    Dim MySheet2 As Worksheet
    Dim MyConn As ADODB.Connection
    Dim MyRecordSet As ADODB.Recordset
    Dim wsFanned As Worksheet, wsTarget As Worksheet
    Set wsTarget = Sheets("Risk Init Pivot")
    Set wsFanned = Sheets("Fanned File")

    'Initiate
    wsTarget.Cells.Delete

    'Find Range Coordinates Dynamically
    If wsFanned.AutoFilterMode Then
        If wsFanned.FilterMode Then wsFanned.ShowAllData
    End If

    SR1_LastRow = wsFanned.Cells(wsFanned.Rows.Count, "A").End(xlUp).Row
    SR1_LastColumn = wsFanned.Cells(SR1_LastRow, wsFanned.Columns.Count).End(xlToLeft).Column

    MyLoop = WorksheetFunction.RoundUp(SR1_LastRow / 60000, 0)

    NewRowCount = 0

    For j = 1 To MyLoop

        'Set Up Connection Details
        Set MyConn = New ADODB.Connection
        MyConn.CommandTimeout = 0
        Set MyRecordSet = New ADODB.Recordset

        MyConn.Open "Provider = Microsoft.ACE.OLEDB.12.0;" & _
        "Data Source = " & Application.ThisWorkbook.FullName & ";" & _
        "Extended Properties = ""Excel 12.0 Xml;HDR=YES;IMEX=1"";"
        Set MyRecordSet.ActiveConnection = MyConn

        'First Time
        If SR1_LastRow > 60000 Then
            NewRowCount = SR1_LastRow - 60000
            SR1_LastRow = 60000
            SR1_FirstRow = 1

            'Set the tables equal to the respective ranges
            Set SheetRange1 = wsFanned.Range("A" & SR1_FirstRow & ":" & Cells(SR1_LastRow, SR1_LastColumn).Address)

            'Pass the table address to a string
            Table1 = SheetRange1.Address

            'Convert the string into a query table - have to get rid of dollar signs for it to work
            Table1 = "[" & wsFanned.Name & "$" & Replace(Table1, "$", "") & "]"

        'Does this until NewRowCount falls into last time
        ElseIf NewRowCount > 60000 Then
            NewRowCount = NewRowCount - 60000
            SR1_FirstRow = SR1_LastRow + 1
            SR1_LastRow = SR1_LastRow + 60000

            Sheets.Add After:=wsFanned
            Set MySheet2 = ActiveSheet

            wsFanned.Rows("1:1").Copy
            MySheet2.Rows("1:1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

            wsFanned.Range("A" & SR1_FirstRow & ":" & Cells(SR1_LastRow, SR1_LastColumn).Address).Copy
            MySheet2.Range("A2").PasteSpecial xlPasteValues
            Set MyRange = MySheet2.UsedRange

            'Set the tables equal to the respective ranges
            Table1 = MyRange.Address

            'Convert the string into a query table - have to get rid of dollar signs for it to work
            Table1 = "[" & MySheet2.Name & "$" & Replace(Table1, "$", "") & "]"

        'Last Time
        ElseIf (NewRowCount > 0) And (NewRowCount <= 60000) Then
            SR1_FirstRow = SR1_LastRow + 1
            SR1_LastRow = SR1_LastRow + NewRowCount
            NewRowCount = 0


            Sheets.Add After:=wsFanned
            Set MySheet2 = ActiveSheet

            wsFanned.Rows("1:1").Copy
            MySheet2.Rows("1:1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

            wsFanned.Range("A" & SR1_FirstRow & ":" & Cells(SR1_LastRow, SR1_LastColumn).Address).Copy
            MySheet2.Range("A2").PasteSpecial xlPasteValues

            'Set the tables equal to the respective ranges
            Table1 = MySheet2.UsedRange
            'Convert the string into a query table - have to get rid of dollar signs for it to work
            Table1 = "[" & MySheet2.Name & "$" & Replace(Table1, "$", "") & "]"

        'Does this the first time if under 60k rows
        Else
            SR1_FirstRow = 1

            'Set the tables equal to the respective ranges
            Set SheetRange1 = wsFanned.Range("A" & SR1_FirstRow & ":" & Cells(SR1_LastRow, SR1_LastColumn).Address)

            'Pass the table address to a string
            Table1 = SheetRange1.Address

            'Convert the string into a query table - have to get rid of dollar signs for it to work
            Table1 = "[" & SheetTable1 & "$" & Replace(Table1, "$", "") & "]"

        End If

        'SQL Statement
        MySQL = Sheets("Control Sheet").Range("C14").Value
        MySQL = Replace(MySQL, "@Table1", Table1)
        MySQL = Replace(MySQL, "@Year", Sheets("Control Sheet").Range("C5").Value)
        MySQL = Replace(MySQL, "@FA_PQ_Input", FA_PQ)
        MySQL = Replace(MySQL, "@SubChannel", SubChannel)
        MySQL = Replace(MySQL, "@MyMonth", MyMonth)

        MsgBox MySQL

        'Run SQL
        MyRecordSet.Open MySQL, MyConn, adOpenKeyset, adLockOptimistic

        'Paste Data with headers to location
        wsTarget.Range("A" & 1 + SR1_FirstRow).CopyFromRecordset MyRecordSet

        For i = 0 To MyRecordSet.Fields.Count - 1
            wsTarget.Cells(1, i + 1) = MyRecordSet.Fields(i).Name
            With wsTarget.Cells(1, i + 1)
                .Font.Bold = True
                .Font.Size = 10
            End With
        Next i

        MyRecordSet.Close
        Set MyRecordSet = Nothing

        MyConn.Close
        Set MyConn = Nothing
    Next j

    ''Putting Nulls in the blanks
    'ActiveSheet.Cells.Replace What:="", Replacement:="NULL", LookAt:=xlWhole, SearchOrder:=xlByRows, MatchCase:=True, _
    '                          SearchFormat:=False, ReplaceFormat:=False

    'Tidying the sheet
    ActiveSheet.Cells.AutoFilter
    ActiveSheet.Columns.AutoFit
    ActiveSheet.Range("A1").Select
    Sheets("Control Sheet").Activate

    Application.ScreenUpdating = True
End Sub
Xabier
  • 7,587
  • 1
  • 8
  • 20
  • Duplicate definition of `wsFanned`. Also, think `MySheet2.UsedRange` is redundant as it's immediately followed by `Set MyRange = MySheet2.UsedRange`. Otherwise, amazing - how it should be written! – Alan Jun 20 '18 at 11:44
  • @Alan, I've now updated it to reflect your comments, thank you! I just did it quickly to attempt to show the OP how they can avoid Select/Activate. :) – Xabier Jun 20 '18 at 12:46
  • @Xabier I appreciate the time you took to tidy it up. I am self-taught and so do not always know all of the tricks, so it was interesting to see another way of doing things. After tweaking a few minor things, I tested it and it does work. Unfortunately it works the same way my code did, and still gives the same result. I appreciate your time and effort at showing me some new ideas. Thanks. – Rick W. Jun 20 '18 at 13:16
  • @RickW. After showing us the error you are getting, I have updated the code a little more, not sure if it will work as expected, but worth a try, I guess... – Xabier Jun 20 '18 at 14:28
  • @Xabier I honestly can't tell what you have changed, but maybe it's because you updated some things that I already updated on my end... maybe if you clarify the update I'll see it. – Rick W. Jun 20 '18 at 14:50
  • @RickW. I've updated the following line `Table1 = "[" & SheetTable1 & "$" & Replace(Table1, "$", "") & "]"`, as this is the line that is illustrated in the error, not sure if it will resolve the issue, but it is definitely a step in the right direction...(I believe) – Xabier Jun 20 '18 at 15:17
  • @Xabier yes that was one of the things I changed to implement your code. I know that you have no real way of testing, so I didn't think it was worth mentioning to you. There were a couple of places that needed some changes, ones that you no doubt would have seen if you had been able to run it in my environment. That was not the answer ultimately :( – Rick W. Jun 20 '18 at 15:19
1

Excel thinks your recordset is empty.

It's not a memory error.

With 80k rows, your code enters the ElseIf (NewRowCount > 0) And (NewRowCount <= 60000) Then block. When it tries to call the associated recordset, it fails.

You can test this behaviour by changing this line of code:

MyRecordSet.Open MySQL, MyConn, adOpenKeyset, adLockOptimistic

to:

On Error Resume Next
MyRecordSet.Open MySQL, MyConn, adOpenKeyset, adLockOptimistic
If MyRecordSet.EOF Then MsgBox "null"

The code runs correctly the first iteration, second iteration you get the null warning.

Why it is not returning records, I can't tell you. But here is your error.

Alan
  • 2,914
  • 2
  • 14
  • 26
  • Hey this is a good thought. I tried it out and thought through it, but I do have a couple issues with it. 1. The error happens when it tries to run MySQL, saying that it cannot find the table I want to pull from. As a result it would not return anything and by default MyRecordset would be empty as a result of the issue not as a cause of the issue (if I'm thinking of that right). Therefore the msgbox returning null does not actually prove anything. – Rick W. Jun 20 '18 at 13:35
  • 2. The fact that I can get it to run by using a separate sub after the original closes using the same string value for MySQL makes me know that running that SQL will produce results on a normal basis. So I can make excel create the recordset using the same MySQL as long as it is not using the same sub :( I liked that you had an idea to try and thank you for taking the time to think of one, but I don't think that it is valid in this case. I think there may be some misunderstanding around what the error looks like. would it be helpful if I screenshot the error? – Rick W. Jun 20 '18 at 13:35
  • It's probably because it can't find the table. Not exclusively that, as demonstrated by the msgbox displaying the sql text which seems OK at a glance. The point about testing whether the Recordset is empty or not was part of error tracing to find out if the error was in selecting & pasting, grabbing the recordset etc. – Alan Jun 20 '18 at 16:02
  • "would it be helpful if I screenshot the error?" Always. That's not the error I was seeing in my mockup. I saw an Automation error. What version of ADO are you referencing? And are you calling this from another workbook? – Alan Jun 20 '18 at 16:24
  • I originally mentioned what the error was if you look back, but it was my mistake to not screenshot it in the first place. I have ADO 6.0 and ADO Recordset 2.8 in my references. Also, I am only calling from within the same workbook. Also, in reference to your point "it can't find the table", this also is invalid as I mentioned in my post and comments because the same SQL works when used in a separate sub when I have changed nothing. So, it is not having trouble finding it, I think there is an underlying issue making it seem like it is having trouble finding it (ex: >~65k rows) – Rick W. Jun 20 '18 at 18:04
  • "this also is invalid" - incorrect. That fact it works when you do something else does not automatically rule out that it is incorrect in the original instance. – Alan Jun 20 '18 at 18:34
  • not sure what you mean... If I run the same bit of code successfully in the same manner, then how does it not rule out the issue. You may have to provide an example where this logic is faulty... I'm 99% confident that since I have replicated the manner in which it runs the SQL, replicated the SQL, and it does what it is desired to do, that means it works. If I try to call the external sub (where it works) within the original sub, it does not work. Similar to how it does not work within the original sub on its own. – Rick W. Jun 20 '18 at 18:42
  • " I think there is an underlying issue making it seem like it is having trouble finding it". Yes/No. When runs the first iteration (up to 65k) it is running against an existing table (Fanned File). When it enters the second iteration, the ADO connection is not recognising that a new worksheet has been added *and thus does not find the table*. Excel itself is finding the table, as demonstrated hopefully by the messagebox popups. When you run the command in a separate Sub, the sheet exists *from the get go* and therefore no issue. – Alan Jun 20 '18 at 18:46
  • Why the recordset is not finding the table, I don't have enough information to trace. In my mockup I get a different error - Automation failure - rather than table not found. – Alan Jun 20 '18 at 18:47
  • Remember that you are not, although it might seem that way, comparing like for like code - iteration one is different from iteration two is different from a specific snippet running the code directly in a different Sub. – Alan Jun 20 '18 at 18:52
  • I would suggest a 3 step process: (1) modularise your code to make each function easier to trace (2) Look into appending all returned data from the recordset directly into the TargetSheetTable (Risk Init Pivot) - which will be easier with modular code and (3) Plan on eventually moving all data storage over to a database (i.e. Access) which will be much easier to query from Excel. – Alan Jun 20 '18 at 18:57
  • oh I would love to have it in Access or SQL Server, but that is not up to me. Okay, so if I understand you right, you are saying that the ADO connection somehow does not see that the sheet is there even though Excel does. That is an interesting thought. If that is what you are saying, and that is the issue, how can I go about making the new sheet register with the ADO? I tried doing (1) by calling the sub that worked, but I'll try breaking out the connection part of it into a different sub and see what happens there. (2) is already part of the plan for this code. I'll report back what happens. – Rick W. Jun 20 '18 at 19:12
  • Yes. I tried telling it to refresh the workbook and to save the workbook, but neither were successful. I did get it to run without declaring an error by copying the initialisation of the connection and recordset and duplicating it as part of each iteration. However, that still didn't copy over the second set of data - it stopped at 59k. – Alan Jun 20 '18 at 19:38
  • 1
    Perhaps it is worth considering going in the other direction? Rather than dynamically adding a new worksheet, create a number of result-holding worksheets (e.g. Results1 - Results10). Hide them - hidden or very hidden. Ideally, have fixed source sheets as well and split the data into 60k chunks. Then you can hard-code all of your calls - Source1 -> Results1 etc. Removes the need to loop over the results, you can just access the `UsedRange` for each sheet used (and you can track the used sheets in your control sheet). – Alan Jun 20 '18 at 19:44
  • 1
    I tested what you were saying, and I think it is caused by the ADO not recognizing it. I had it run through by forcing it to use a table that existed prior to running, and it did what was desired. So, I will try and work this into a solution similar to what you are eluding to, and I'll post a solution here once complete. Thanks Alan! I appreciate the time you have spent on this helping me figure it out. – Rick W. Jun 20 '18 at 20:10
  • Glad I could help. It's frustrating not to know why ADO doesn't see it when Excel clearly does. OTOH any solution that works is the right solution. – Alan Jun 20 '18 at 20:27
0

Thanks to Xabier and Alan for their contributions to the solution.

Xabier for the cleaner code. Alan for identifying the underlying issue.

The issue is that when the original table gets split onto the new sheet to account for the excess rows, even though the sheet exists, the ADO was not recognizing it yet. It's not until you leave the current sub that it recognizes it (at least that is my understanding from all of the discussion, testing, and ultimately my solution).

So, as a high level summary:

  1. To account for too many rows and getting the "Access cannot find your table" error message, I would let the first 60k run on the current sheet and then copy the next 60k (or less) to a new sheet.

  2. In order for the ADO to recognize the newly created sheet, I placed the connection and recordset functionality into a separate sub and called it from within my original sub by passing any parameters that I needed it to have to run successfully.

  3. I then came back to my original sub, deleted the newly created sheet, and then looped through this process again until I had accounted for the entire original sheet.

So, for example, 140k rows would run the first 60k on the original sheet, run the next 60k off of a new sheet, and the last 20k off of another new sheet.

The key really was to put the recordset into a new sub and call it, and this was only necessary because the ADO was not seeing the newly created sheets without first leaving the original sub.

Thanks for all input, and here is my code below in case you are interested. Please note the code will look similar (with some modifications) to the cleaner version that Xabier posted.

Sub Risk_Init_Pivot(FA_PQ As String, Risk_Init As String, SubChannel As String, MyMonth As String)

Application.ScreenUpdating = False


Dim SheetRange1 As Range, MyRange As Range
Dim SR1_LastRow As Double, SR1_LastColumn As Double, NewRowCount As Double, SR1_FirstRow As Double
Dim i As Integer, j As Integer, MyLoop As Integer
Dim Table1 As String, MySQL As String
Dim wsOrigin As Worksheet, wsTarget As Worksheet, MySheet As Worksheet
Set wsTarget = Sheets("Risk Init Pivot")
Set wsOrigin = Sheets("Fanned File")

'Initiate
wsTarget.Cells.ClearContents

'Find Range Coordinates Dynamically
If wsOrigin.AutoFilterMode Then
    If wsOrigin.FilterMode Then wsOrigin.ShowAllData
End If

SR1_LastRow = wsOrigin.Cells(wsOrigin.Rows.Count, "A").End(xlUp).Row
SR1_LastColumn = wsOrigin.Cells(SR1_LastRow, wsOrigin.Columns.Count).End(xlToLeft).Column


MyLoop = WorksheetFunction.RoundUp(SR1_LastRow / 60000, 0)

NewRowCount = 0

For j = 1 To MyLoop


    'First Time
    If SR1_LastRow > 60000 Then
        NewRowCount = SR1_LastRow - 60000
        SR1_LastRow = 0
        SR1_EndRow = 60000
        SR1_FirstRow = 1

        'Set the tables equal to the respective ranges
        Set SheetRange1 = wsOrigin.Range("A" & SR1_FirstRow & ":" & Cells(SR1_EndRow, SR1_LastColumn).Address)

        'Pass the table address to a string
        Table1 = SheetRange1.Address

        'Convert the string into a query table - have to get rid of dollar signs for it to work
        Table1 = "[" & wsOrigin.Name & "$" & Replace(Table1, "$", "") & "]"



    'Does this until NewRowCount falls into last time
    ElseIf NewRowCount > 60000 Then
        NewRowCount = NewRowCount - 60000
        SR1_FirstRow = SR1_EndRow + 1
        SR1_EndRow = SR1_FirstRow + 59999

        Sheets.Add After:=wsOrigin
        Set MySheet = ActiveSheet

        wsOrigin.Rows("1:1").Copy
        MySheet.Rows("1:1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

        wsOrigin.Range("A" & SR1_FirstRow & ":" & Cells(SR1_EndRow, SR1_LastColumn).Address).Copy
        MySheet.Range("A2").PasteSpecial xlPasteValues
        Set MyRange = MySheet.UsedRange

        'Set the tables equal to the respective ranges
        Table1 = MyRange.Address

        'Convert the string into a query table - have to get rid of dollar signs for it to work
        Table1 = "[" & MySheet.Name & "$" & Replace(Table1, "$", "") & "]"


    'Last Time
    ElseIf (NewRowCount > 0) And (NewRowCount <= 60000) Then
        SR1_FirstRow = SR1_EndRow + 1
        SR1_EndRow = SR1_FirstRow + NewRowCount
        NewRowCount = 0

        Sheets.Add After:=wsOrigin
        Set MySheet = ActiveSheet

        wsOrigin.Rows("1:1").Copy
        MySheet.Rows("1:1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

        wsOrigin.Range("A" & SR1_FirstRow & ":" & Cells(SR1_EndRow, SR1_LastColumn).Address).Copy
        MySheet.Range("A2").PasteSpecial xlPasteValues
        Set MyRange = MySheet.UsedRange

        'Set the tables equal to the respective ranges
        Table1 = MyRange.Address
        'Convert the string into a query table - have to get rid of dollar signs for it to work
        Table1 = "[" & MySheet.Name & "$" & Replace(Table1, "$", "") & "]"



    'Does this the first time if under 60k rows
    Else
        SR1_FirstRow = 1

        'Set the tables equal to the respective ranges
        Set SheetRange1 = wsOrigin.Range("A" & SR1_FirstRow & ":" & Cells(SR1_LastRow, SR1_LastColumn).Address)

        'Pass the table address to a string
        Table1 = SheetRange1.Address

        'Convert the string into a query table - have to get rid of dollar signs for it to work
        Table1 = "[" & wsOrigin.Name & "$" & Replace(Table1, "$", "") & "]"


    End If


    Call MyRecordset(Table1, FA_PQ, SubChannel, MyMonth, wsTarget)

    If Not MySheet Is Nothing Then
    Application.DisplayAlerts = False
    MySheet.Delete
    Application.DisplayAlerts = True
    End If

Next j

'Tidying the sheet
wsTarget.Cells.AutoFilter
wsTarget.Columns.AutoFit
Sheets("Control Sheet").Activate

Application.ScreenUpdating = True

End Sub

Sub MyRecordset(Table1 As String, FA_PQ As String, SubChannel As String, MyMonth As 
String, wsTarget As Worksheet)


    Dim MyConn As ADODB.Connection
    Dim MyRecordset As ADODB.RecordSet
    Dim i As Integer
    Dim LastRow As Double


    'Set Up Connection Details
    Set MyConn = New ADODB.Connection
    MyConn.CommandTimeout = 0
    Set MyRecordset = New ADODB.RecordSet

    MyConn.Open "Provider = Microsoft.ACE.OLEDB.12.0;" & _
    "Data Source = " & Application.ThisWorkbook.FullName & ";" & _
    "Extended Properties = ""Excel 12.0 Xml;HDR=YES;IMEX=1"";"
    Set MyRecordset.ActiveConnection = MyConn

    'SQL Statement
    MySQL = Sheets("Control Sheet").Range("C14").Value
    MySQL = Replace(MySQL, "@Table1", Table1)
    MySQL = Replace(MySQL, "@Year", Sheets("Control Sheet").Range("C5").Value)
    MySQL = Replace(MySQL, "@FA_PQ_Input", FA_PQ)
    MySQL = Replace(MySQL, "@SubChannel", SubChannel)
    MySQL = Replace(MySQL, "@MyMonth", MyMonth)

    'Run SQL

    MyRecordset.Open MySQL, MyConn, adOpenKeyset, adLockOptimistic


    'Paste Data with headers to location
    If wsTarget.Range("A2").Value = "" Then
    wsTarget.Range("A2").CopyFromRecordset MyRecordset
    Else
    LastRow = wsTarget.Cells(wsTarget.Rows.Count, "A").End(xlUp).Row
    wsTarget.Range("A" & LastRow + 1).CopyFromRecordset MyRecordset
    End If

    For i = 0 To MyRecordset.Fields.Count - 1
        wsTarget.Cells(1, i + 1) = MyRecordset.Fields(i).Name
        With wsTarget.Cells(1, i + 1)
            .Font.Bold = True
            .Font.Size = 10
        End With
    Next i

    MyRecordset.Close
    Set MyRecordset = Nothing

    MyConn.Close
    Set MyConn = Nothing



    'Putting Nulls in the blanks
    wsTarget.Cells.Replace What:="", Replacement:="0", LookAt:=xlWhole, SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, ReplaceFormat:=False


End Sub
Rick W.
  • 17
  • 5
0

You don't need to split up your queries because you have over 60,000 rows... there is a workaround available.

See here: https://stackoverflow.com/a/51402496/1274820

Instead of referencing the range, just reference the sheet.

This goes for named ranges too (which will fail).

If your data is on Sheet1 range A1:N152679 for example, just use SELECT SomeData FROM [Sheet1$] - there's no limit.

Instead of going through the effort of splitting up your data and queries weirdly, place them on another sheet temporarily if need be.

Excel can handle up to 1,048,576 rows in this manner.

user1274820
  • 7,786
  • 3
  • 37
  • 74