Solved

Excel 2016 VBA - loop slows down

Posted on 2016-10-30
8
71 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
0
Comment
Question by:hindersaliva
  • 4
  • 2
  • 2
8 Comments
 
LVL 49

Expert Comment

by:Rgonzo1971
ID: 41865904
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
0
 

Assisted Solution

by:hindersaliva
hindersaliva earned 0 total points
ID: 41866534
Rgonzo, you'ew right. The sSQL was getting longer and longer! I added another variable sSQL1 to hold the first part of the SQL.

Sub PutData()

    Range("K9").Value = ""

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

'    MsgBox iLastRow

    sSQL1 = "INSERT INTO " + strTable + " ("    '********<<< sSQL1 variable to hold part 1 of the SQL

    i = 1
    For Each cell In Range("Fieldlist")

        If cell.Value <> "" Then
            If i < Range("Fieldlist").Columns.Count Then
                sSQL1 = sSQL1 + cell.Value + ", "
            Else
                sSQL1 = sSQL1 + cell.Value + ") "
            End If
        End If
        i = i + 1
    Next cell

    sSQL1 = sSQL1 + "VALUES("
        
    iRow = Range("DataTopLeft").Row
    
    Do Until iRow = iLastRow
    
        sSQL = sSQL1        '************ <<<<<<<< THIS
    
        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           'commented out as it slowed down the execution a bit.
    Loop
    
    Sheets("Debug").Range("A1").Value = sSQL
    
    MsgBox "Done"

End Sub

Open in new window


I commented out the VBA.DoEvents as not sure what it does and it slowed down the execution a bit.
0
 
LVL 49

Accepted Solution

by:
Rgonzo1971 earned 500 total points
ID: 41866654
DoEvents passes control to the operating system. Control is returned after the operating system has finished processing the events in its queue ( You can get rid of "Not responding")

you could use an array to store temporarly the sql
Sub PutData()
Dim aSql() As String
j = 0
    Range("K9").Value = ""

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

'    MsgBox iLastRow

    sSQL1 = "INSERT INTO " + strTable + " ("
    
    i = 1
    For Each cell In Range("Fieldlist")
    
        If cell.Value <> "" Then
            If i < Range("Fieldlist").Columns.Count Then
                sSQL1 = sSQL1 + cell.Value + ", "
            Else
                sSQL1 = sSQL1 + cell.Value + ") "
            End If
        End If
        i = i + 1
    Next cell
    
    iRow = Range("DataTopLeft").Row
    
    Do Until iRow = iLastRow
        sSQL = ""
        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
        ReDim Preserve aSql(j)
        aSql(j) = sSQL
        j = j + 1
    
    Loop
    

    sSQL = sSQL1 + "VALUES(" & Join(aSql, "")
    Sheets("Debug").Range("A1").Value = sSQL
    
    MsgBox "Done"

End Sub

Open in new window

0
Master Your Team's Linux and Cloud Stack!

The average business loses $13.5M per year to ineffective training (per 1,000 employees). Keep ahead of the competition and combine in-person quality with online cost and flexibility by training with Linux Academy.

 

Author Comment

by:hindersaliva
ID: 41866659
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.
0
 
LVL 13

Expert Comment

by:ioane
ID: 41866766
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

0
 

Author Comment

by:hindersaliva
ID: 41866798
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?
0
 

Author Comment

by:hindersaliva
ID: 41866847
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
0
 
LVL 13

Expert Comment

by:ioane
ID: 41867571
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.
0

Featured Post

Netscaler Common Configuration How To guides

If you use NetScaler you will want to see these guides. The NetScaler How To Guides show administrators how to get NetScaler up and configured by providing instructions for common scenarios and some not so common ones.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Suggested Solutions

Modern/Metro styled message box and input box that directly can replace MsgBox() and InputBox()in Microsoft Access 2013 and later. Also included is a preconfigured error box to be used in error handling.
Excel can be a tricky bit of software to get your head around. Whilst you’ll be able to eventually get to grips with the basic understanding of how to get by, there are a few Excel tips that not everybody will even know about let alone know how to d…
The viewer will learn how to create a normally distributed random variable in Excel, use a normal distribution to simulate the return on an investment over a period of years, Create a Monte Carlo simulation using a normal random variable, and calcul…
This Micro Tutorial demonstrate the bugs in Microsoft Excel for Mac with Pivot Charts.

770 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question