Need code to iterate to 1000 rows at a time..

[supdawg]

Ok, I feel really sad asking for help with this because it should be easy for me to do. I've literally spent hours searching thinking about this and I cannot come up with a solution:

My current project is close to being finished, but I need to get this last thing working in code.

Essentially what I need is for my code to perform this procedure for 2000 rows at a time until it reaches the bottom of the row. If I try to run more than 2000 items through this my code fails, so that's why I need to break it up into 2000 items at a time.

Here's my code:

Function to build string to use as IN Operator with SQL statement. (works great)

Function MakeSQL(rng As Range) As Variant
    Dim oCell As Range
 
'function to build string from range of order numbers
 
    For Each oCell In rng.Cells
      MakeSQL = MakeSQL & ", '" & oCell.Value & "'"
    Next oCell
 
    MakeSQL = "IN (" & CStr(Mid(MakeSQL, 3)) & ")"
 
End Function

2nd bit of code:

Sub PKMS_BOM_DATA()
 
Dim PKMSID As String
Dim LastRow As Long, LastRowData As Long
Dim str As String
Dim wb As Workbook
Set wb = ThisWorkbook
Dim i As Integer
On Error GoTo ErrorHandler
LastRow = wb.Sheets("OrderNumbers").Range("A" & Rows.Count).End(xlUp).Row
LastRowData = wb.Sheets("Data").Range("A" & Rows.Count).End(xlUp).Row
Application.ScreenUpdating = False
 
    PKMSID = InputBox("PKMS Login")
    PKMSID = UCase(PKMSID)
 
    If PKMSID = "" Then
        MsgBox "You must enter your PKMS login info"
        Exit Sub
    End If
 
 
        If LastRowData > 1 Then
            LastRowData = LastRowData + 1
        End If
 
 
        str = "SELECT PHPICK00.PHPKTN, PDPICK00.PDSTYL, PDPICK00.PDOPQT, PDPICK00.PDSTYD, PHPICK00.PHPSTF" & Chr(13) & "" & Chr(10) & "FROM CAPM01.WM0272PRDD.PDPICK00 PDPICK00, CAPM01.WM0272PRDD.PHPICK00 PHPICK00" & Chr(13) & "" & Chr(10) & "WHERE PDPICK00.PDPCTL = PHPICK00.PHPCTL AND ((PHPICK00.PHWHSE='BNA') AND (PHPICK00.PHPSTF<='99') AND (PHPICK00.PHPKTN " & MakeSQL(Sheet2.Range("A1:A" & LastRow)) & "))"
 
        With wb.Sheets("Data").ListObjects.Add(SourceType:=0, Source:=Array(Array( _
            "ODBC;DRIVER={iSeries Access ODBC Driver};UID=" & PKMSID & ";SIGNON=1;PKG=QGPL/DEFAULT(IBM),2,0,1,0,512;LANGUAGEID=ENU;DFTPKGLIB=QGPL;DBQ=Q" _
            ), Array("GPL WM0272PRDD;SYSTEM=US.CORP;")), Destination:=wb.Sheets("Data").Range("A" & i)).QueryTable
            .CommandText = str ' SQL code stored in string
            .RowNumbers = False
            .FillAdjacentFormulas = False
            .PreserveFormatting = True
            .RefreshOnFileOpen = False
            .BackgroundQuery = True
            .RefreshStyle = xlInsertDeleteCells
            .SavePassword = False
            .SaveData = True
            .AdjustColumnWidth = True
            .RefreshPeriod = 0
            .PreserveColumnInfo = True
            .ListObject.DisplayName = "Table_qry3NV_Demand2"
            .Refresh BackgroundQuery:=False
           ' .Delete
        End With

So basically, I need it to build the string for 2000 rows at a time until it reaches the end of the row of data.

 

[AlphaFrog]

This is not tested.

Dim wb As Workbook[COLOR="Red"], rng As Range[/COLOR]
Set wb = ThisWorkbook
Dim i As [COLOR="Red"]Long[/COLOR]
On Error GoTo ErrorHandler
lastrow = wb.Sheets("OrderNumbers").Range("A" & Rows.Count).End(xlUp).Row
LastRowData = wb.Sheets("Data").Range("A" & Rows.Count).End(xlUp).Row
Application.ScreenUpdating = False
 
    PKMSID = InputBox("PKMS Login")
    PKMSID = UCase(PKMSID)
 
    If PKMSID = "" Then
        MsgBox "You must enter your PKMS login info"
        Exit Sub
    End If
 
 
        If LastRowData > 1 Then
            LastRowData = LastRowData + 1
        End If
 
        [COLOR="Red"]For i = 1 To LastRowData Step 2000
        
           Set rng = Sheet2.Range("A" & i).Resize(Application.Min(2000, LastRowData - i))[/COLOR]
        
           Str = "SELECT PHPICK00.PHPKTN, PDPICK00.PDSTYL, PDPICK00.PDOPQT, PDPICK00.PDSTYD, PHPICK00.PHPSTF" & Chr(13) & "" & Chr(10) & "FROM CAPM01.WM0272PRDD.PDPICK00 PDPICK00, CAPM01.WM0272PRDD.PHPICK00 PHPICK00" & Chr(13) & "" & Chr(10) & "WHERE PDPICK00.PDPCTL = PHPICK00.PHPCTL AND ((PHPICK00.PHWHSE='BNA') AND (PHPICK00.PHPSTF<='99') AND (PHPICK00.PHPKTN " & MakeSQL([COLOR="Red"]rng[/COLOR]) & "))"
    
           With wb.Sheets("Data").ListObjects.Add(SourceType:=0, Source:=Array(Array( _
               "ODBC;DRIVER={iSeries Access ODBC Driver};UID=" & PKMSID & ";SIGNON=1;PKG=QGPL/DEFAULT(IBM),2,0,1,0,512;LANGUAGEID=ENU;DFTPKGLIB=QGPL;DBQ=Q" _
               ), Array("GPL WM0272PRDD;SYSTEM=US.CORP;")), Destination:=[COLOR="Red"]wb.Sheets("Data").Range("A" & i)[/COLOR]).QueryTable
               .CommandText = Str ' SQL code stored in string
               .RowNumbers = False
               .FillAdjacentFormulas = False
               .PreserveFormatting = True
               .RefreshOnFileOpen = False
               .BackgroundQuery = True
               .RefreshStyle = xlInsertDeleteCells
               .SavePassword = False
               .SaveData = True
               .AdjustColumnWidth = True
               .RefreshPeriod = 0
               .PreserveColumnInfo = True
               .ListObject.DisplayName = "Table_qry3NV_Demand2"
               .Refresh BackgroundQuery:=False
              ' .Delete
           End With
        
        [COLOR="Red"]Next i[/COLOR]

 

[supdawg]

Thank you .. I knew it could be using For loop with step.. Just couldn't figure out how to change the range size..

Exactly what I was looking for.