Want to win a PS4? Go Premium and enter to win our High-Tech Treats giveaway. Enter to Win

x
?
Solved

Excel 2016 VBA - loop slows down

Posted on 2016-10-30
8
Medium Priority
?
190 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
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 4
  • 2
  • 2
8 Comments
 
LVL 53

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 53

Accepted Solution

by:
Rgonzo1971 earned 2000 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
Industry Leaders: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

 

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

Free Tool: ZipGrep

ZipGrep is a utility that can list and search zip (.war, .ear, .jar, etc) archives for text patterns, without the need to extract the archive's contents.

One of a set of tools we're offering as a way to say thank you for being a part of the community.

Question has a verified solution.

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

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…
Access developers frequently have requirements to interact with Excel (import from or output to) in their applications.  You might be able to accomplish this with the TransferSpreadsheet and OutputTo methods, but in this series of articles I will di…
This Micro Tutorial will demonstrate in Google Sheets how to use the HYPERLINK function to create live links inside your spreadsheet.
Many functions in Excel can make decisions. The most simple of these is the IF function: it returns a value depending on whether a condition you describe is true or false. Once you get the hang of using the IF function, you will find it easier to us…

636 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