Avatar of hindersaliva
hindersaliva
Flag for United Kingdom of Great Britain and Northern Ireland asked on

Excel 2016 VBA - loop slows down

I got a string assembled in a loop as below. The list is 999 rows long, so it goes that many times.
I've got a counter running and I see something curious. It runs fast up to about 300 and then slows down, and gets progressively slower.

I'm wondering why. Also sometimes Excel says 'not responding' although it keeps working.
I need to ensure that there is nothing technically wrong with my code that may be bad programming, 'memory management' or anything like that.
Thanks. (See attached file also)

Sub PutData()

    Range("K9").Value = ""

    iFieldTypeRow = Range("Fieldlist").Row + 1
    strTable = "tblData"
    iLastRow = Range("DataTopLeft").Row + Range("DataRange").Rows.Count - 1

    sSQL = "INSERT INTO " + strTable + " ("
    
    i = 1
    For Each cell In Range("Fieldlist")
    
        If cell.Value <> "" Then
            If i < Range("Fieldlist").Columns.Count Then
                sSQL = sSQL + cell.Value + ", "
            Else
                sSQL = sSQL + cell.Value + ") "
            End If
        End If
        i = i + 1
    Next cell
    
    sSQL = sSQL + "VALUES("
    
    iRow = Range("DataTopLeft").Row
    
    Do Until iRow = iLastRow
    
        i = 1
        For Each cell In Range("Fieldlist")
            
            iCol = cell.Column
            
            If cell.Value <> "" Then
                
                'if TEXT
                If Cells(iFieldTypeRow, iCol).Value = "202" Then
                    If i < Range("Fieldlist").Columns.Count Then
                        sSQL = sSQL + "'" + Cells(iRow, iCol).Value + "', "
                    Else
                        sSQL = sSQL + "'" + Cells(iRow, iCol).Value + "') "
                    End If
                End If
            
                'if LONG TEXT
                If Cells(iFieldTypeRow, iCol).Value = "203" Then
                    If i < Range("Fieldlist").Columns.Count Then
                        sSQL = sSQL + "'" + Cells(iRow, iCol).Value + "', "
                    Else
                        sSQL = sSQL + "'" + Cells(iRow, iCol).Value + "') "
                    End If
                End If
                
                'if NUMBER
                If Cells(iFieldTypeRow, iCol).Value = "3" Then
                    If i < Range("Fieldlist").Columns.Count Then
                        sSQL = sSQL + SQLNumber(Cells(iRow, iCol).Value) + ", "
                    Else
                        sSQL = sSQL + SQLNumber(Cells(iRow, iCol).Value) + ")) "
                    End If
                End If
                
                'if DATE
                If Cells(iFieldTypeRow, iCol).Value = "7" Then
                    If i < Range("Fieldlist").Columns.Count Then
                        sSQL = sSQL + SQLDate(Cells(iRow, iCol).Value) + ", "
                    Else
                        sSQL = sSQL + SQLDate(Cells(iRow, iCol).Value) + ") "
                    End If
                End If
                    
            End If
            i = i + 1
        Next cell
        
        Range("K9").Value = iRow - Range("DataTopLeft").Row
        
        iRow = iRow + 1
    
    Loop
    
    Sheets("Debug").Range("A1").Value = sSQL
    
    MsgBox "Done"

End Sub

Open in new window

Question-for-E-E.xlsm
VBAMicrosoft Excel

Avatar of undefined
Last Comment
ioane

8/22/2022 - Mon
Rgonzo1971

HI,

pls try

Sub PutData()

    Range("K9").Value = ""

    iFieldTypeRow = Range("Fieldlist").Row + 1
    strTable = "tblData"
    iLastRow = Range("DataTopLeft").Row + Range("DataRange").Rows.Count - 1

'    MsgBox iLastRow

    sSQL = "INSERT INTO " + strTable + " ("
    
    i = 1
    For Each cell In Range("Fieldlist")
    
        If cell.Value <> "" Then
            If i < Range("Fieldlist").Columns.Count Then
                sSQL = sSQL + cell.Value + ", "
            Else
                sSQL = sSQL + cell.Value + ") "
            End If
        End If
        i = i + 1
    Next cell
    
    sSQL = sSQL + "VALUES("
    
    iRow = Range("DataTopLeft").Row
    
    Do Until iRow = iLastRow
    
        i = 1
        For Each cell In Range("Fieldlist")
            
            iCol = cell.Column
            
            If cell.Value <> "" Then
                
                'if TEXT
                If Cells(iFieldTypeRow, iCol).Value = "202" Then
                    If i < Range("Fieldlist").Columns.Count Then
                        sSQL = sSQL + "'" + Cells(iRow, iCol).Value + "', "
                    Else
                        sSQL = sSQL + "'" + Cells(iRow, iCol).Value + "') "
                    End If
                End If
            
                'if LONG TEXT
                If Cells(iFieldTypeRow, iCol).Value = "203" Then
                    If i < Range("Fieldlist").Columns.Count Then
                        sSQL = sSQL + "'" + Cells(iRow, iCol).Value + "', "
                    Else
                        sSQL = sSQL + "'" + Cells(iRow, iCol).Value + "') "
                    End If
                End If
                
                'if NUMBER
                If Cells(iFieldTypeRow, iCol).Value = "3" Then
                    If i < Range("Fieldlist").Columns.Count Then
                        sSQL = sSQL + SQLNumber(Cells(iRow, iCol).Value) + ", "
                    Else
                        sSQL = sSQL + SQLNumber(Cells(iRow, iCol).Value) + ")) "
                    End If
                End If
                
                'if DATE
                If Cells(iFieldTypeRow, iCol).Value = "7" Then
                    If i < Range("Fieldlist").Columns.Count Then
                        sSQL = sSQL + SQLDate(Cells(iRow, iCol).Value) + ", "
                    Else
                        sSQL = sSQL + SQLDate(Cells(iRow, iCol).Value) + ") "
                    End If
                End If
                    
            End If
            i = i + 1
        Next cell
        
        Range("K9").Value = iRow - Range("DataTopLeft").Row
        
        iRow = iRow + 1
        VBA.DoEvents
    Loop
    
    Sheets("Debug").Range("A1").Value = sSQL
    
    MsgBox "Done"

End Sub

Open in new window

the sSql var is getting huge that's why is getting longer and longer

Regards
SOLUTION
hindersaliva

Log in or sign up to see answer
Become an EE member today7-DAY FREE TRIAL
Members can start a 7-Day Free trial then enjoy unlimited access to the platform
Sign up - Free for 7 days
or
Learn why we charge membership fees
We get it - no one likes a content blocker. Take one extra minute and find out why we block content.
Not exactly the question you had in mind?
Sign up for an EE membership and get your own personalized solution. With an EE membership, you can ask unlimited troubleshooting, research, or opinion questions.
ask a question
ASKER CERTIFIED SOLUTION
Log in to continue reading
Log In
Sign up - Free for 7 days
Get an unlimited membership to EE for less than $4 a week.
Unlimited question asking, solutions, articles and more.
hindersaliva

ASKER
Thanks for explaining DoEvents. That would be useful as I get nervous when I get 'not responding' message. It's worth the slight slow down of execution.

I will be sending the INSERT statement to the database on each pass of the loop. So I won't need to preserve the SQL.

Thanks.
ioane

Hi Hindersaliva,

There are a couple of things you can do to speed this up.

1. Read and writes from the spreadsheet take a long time. Reduce the number of reads.

2. As noted above, changing a string variable actually involves copying the string to a new location in memory. Reduce the number of times you overwrite the same string variable, especially large strings.

I have rewritten your sub procedure taking these two points into account by writing your base data into arrays first, then building your SQL from that.

I think you also had some missing brackets in your VALUES statement (am assuming you are using SQL Server format for multiple values rows).

Sub PutData()
    Dim varHeaders() As Variant, varData() As Variant, varFieldType() As Variant, varRowData() As Variant
    Dim sSQL As String, strTable As String, strRowData As String
    Dim i As Long, iRow As Long, iCol As Long
    Dim booNull As Boolean
     
    Range("K9").Value = ""

    varFieldType = Sheet1.Range("Fieldlist").Offset(1, 0)
    strTable = "tblData"

'    MsgBox iLastRow

    sSQL = "INSERT INTO " & strTable & " ("
    
    'Read Headers into array
    varHeaders = Sheet1.Range("FieldList")
    
    'Write Headers to SQL string
    For iCol = 1 To UBound(varHeaders, 2)
        If varHeaders(1, iCol) <> "" Then
            strRowData = strRowData & "," & varHeaders(1, iCol)
        End If
    Next iCol
    
    sSQL = sSQL & Mid(strRowData, 2) & ")" & "VALUES "
    strRowData = ""
    
    'Read row Values to array
    varData = Sheet1.Range("DataRange")
    ReDim varRowData(1 To UBound(varData, 1))
    
    i = 0
    For iRow = 1 To UBound(varData, 1)
        strRowData = ""
        booNull = True
        For iCol = 1 To UBound(varHeaders, 2)
        
            If varHeaders(1, iCol) <> "" Then
                
                If varData(iRow, iCol) <> "" And varData(iRow, iCol) <> "Null" Then
                    booNull = False
                End If
                
                Select Case varFieldType(1, iCol)
                'if TEXT or LONG TEXT
                Case "202", "203"
                    strRowData = strRowData & ",'" & varData(iRow, iCol) & "'"
                    
                'if NUMBER
                Case "3"
                    strRowData = strRowData & "," & varData(iRow, iCol)
                
                'if DATE
                Case "7"
                    strRowData = strRowData & "," & SQLDate(varData(iRow, iCol))
                End Select
                
            End If
        Next iCol
        
        If booNull = False Then
            i = i + 1
            varRowData(i) = "(" & Mid(strRowData, 2) & ")"
        End If
        
        'Not sure why you need this line as will impact performance...
        Sheet1.Range("K9").Value = i
        
    Next iRow
    
    'Restrict array to dataset
    ReDim Preserve varRowData(1 To i)
    
    'Write Values to SQL string
    sSQL = sSQL & Join(varRowData, ",")
    
    Sheets("Debug").Range("A3").Value = sSQL
    
    MsgBox "Done"

End Sub

Open in new window

I started with Experts Exchange in 2004 and it's been a mainstay of my professional computing life since. It helped me launch a career as a programmer / Oracle data analyst
William Peck
hindersaliva

ASKER
OMG! Loane! That goes like lightning!

I must study Loane's code, and anyone else reading this.

(BTW the counter was to monitor the speed and progress.)

Loane, I've already allocated the points. You deserve some. Admin, what can I do?
hindersaliva

ASKER
Loane, I had an error and posted the it as a new question. See here
https://www.experts-exchange.com/questions/28979973/Excel-VBA-SQL-Statement-'missing-'-error.html
ioane

Hi hindersaliva,

Apologies, from your original code I assumed you were using SQL Server.

I can't work on your issue until tonight, but there is a simple way you can do this in MS Access.

Forget about the SQL string, it will be too slow going row by row.

1. Use VBA to write your data into a csv file, (the code I have provided previously should do half of this already)
2. Import the file using: DoCmd.TransferText

This will be a much faster solution.

If you have no luck by tonight, I will post some code to do this.

Cheers.
Get an unlimited membership to EE for less than $4 a week.
Unlimited question asking, solutions, articles and more.