We help IT Professionals succeed at work.

Excel 2016 VBA - loop slows down

hindersaliva
hindersaliva asked
on
875 Views
Last Modified: 2016-10-31
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
Comment
Watch Question

CERTIFIED EXPERT
Top Expert 2016

Commented:
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
This one is on us!
(Get your first solution completely free - no credit card required)
UNLOCK SOLUTION
CERTIFIED EXPERT
Top Expert 2016
Commented:
This one is on us!
(Get your first solution completely free - no credit card required)
UNLOCK SOLUTION

Author

Commented:
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.
ioanePlanning & Analytics Manager

Commented:
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

Author

Commented:
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?

Author

Commented:
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
ioanePlanning & Analytics Manager

Commented:
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.
Unlock the solution to this question.
Join our community and discover your potential

Experts Exchange is the only place where you can interact directly with leading experts in the technology field. Become a member today and access the collective knowledge of thousands of technology experts.

*This site is protected by reCAPTCHA and the Google Privacy Policy and Terms of Service apply.

OR

Please enter a first name

Please enter a last name

8+ characters (letters, numbers, and a symbol)

By clicking, you agree to the Terms of Use and Privacy Policy.