Solved

Excel 2016 VBA - loop slows down

Posted on 2016-10-30
8
47 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 48

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 48

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
 

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
What Is Threat Intelligence?

Threat intelligence is often discussed, but rarely understood. Starting with a precise definition, along with clear business goals, is essential.

 
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

How to run any project with ease

Manage projects of all sizes how you want. Great for personal to-do lists, project milestones, team priorities and launch plans.
- Combine task lists, docs, spreadsheets, and chat in one
- View and edit from mobile/offline
- Cut down on emails

Join & Write a Comment

How to quickly and accurately populate Word documents with Excel data, charts and images (including Automated Bookmark generation) David Miller (dlmille) Synopsis In this article you’ll learn how to use ExcelToWord! to copy data,charts, shapes …
Since upgrading to Office 2013 or higher installing the Smart Indenter addin will fail. This article will explain how to install it so it will work regardless of the Office version installed.
This Micro Tutorial will demonstrate in Google Sheets how to use the HYPERLINK function to create live links inside your spreadsheet.
This Micro Tutorial demonstrates in Microsoft Excel how to consolidate your marketing data by creating an interactive charts using form controls. This creates cool drop-downs for viewers of your chart to choose from.

705 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

Need Help in Real-Time?

Connect with top rated Experts

18 Experts available now in Live!

Get 1:1 Help Now