VBA code to let Excel "breath"?

Jaymond Flurrie

Well-known Member
Joined
Sep 22, 2008
Messages
868
I have a code that works "perfectly". It writes 350 000 rows into a text file. I want to let user know what is happening so I use application.statusbar with a mod operation, like this:


Code:
For L = LBound(vCards, 1) + 1 To UBound(vCards, 1) 'Skip header row
            strCard = L & vbTab & vCards(L, 2) & vbTab & vCards(L, 3) & vbTab & vCards(L, 4) & vbTab & vCards(L, 5) & vbTab & vCards(L, 6) & vbTab & vCards(L, 7) & vbTab & vCards(L, 8) & vbTab & vCards(L, 9) & vbTab & vCards(L, 10) & vbTab & vCards(L, 10) & vbTab & vCards(L, 11) & vbTab & vCards(L, 12) & vbTab & vCards(L, 13)
            
            If L Mod 10000 = 0 Then
                Application.StatusBar = "Creating temporary textfile for uploading, " & L & " of " & UBound(vCards, 1) & " cards processed"
            End If
            
            Print #lProductFile, strCard
        Next L

The problem is that after a while Excel "chokes" and while it does what I want it to do, user gets a pretty clear signal that it crashed. What's the recommended way to let Excel catch it's breath so that even if the code would run slightly slower, I could keep user updated of the process instead of this legendary "The program is not responding"-status?
 

Some videos you may like

Excel Facts

Control Word Wrap
Press Alt+Enter to move to a new row in a cell. Lets you control where the words wrap.

wigi

Well-known Member
Joined
Jul 10, 2006
Messages
7,958
Office Version
  1. 365
Platform
  1. Windows
  2. Mobile
  3. Web
Before answering that question, please show us the entire code.
Why do you write line by line?
 

Jaymond Flurrie

Well-known Member
Joined
Sep 22, 2008
Messages
868
Before answering that question, please show us the entire code.
Why do you write line by line?

How do I print the whole array into a txt-file at once?

Anyway, here:

Code:
Option Explicit


Sub DatabaseToTXT()
    
    Dim lCardFile As Long 'The text file handle
    Dim strCardFile As String 'The name of the text file
    Dim strCard As String 'One card
    Dim vCards As Variant 'The array of cards
    Dim L As Long 'Loop variable
    
    'Inform user of what we're doing
    Application.StatusBar = "Creating temporary textfile for uploading"
    
    'Save the card range to an array to speed up the code
    vCards = shtTemp.Range("A1").CurrentRegion
    
    'Name the temporary file
    strCardFile = ActiveWorkbook.Path & "\cards.txt"
    
    'Check if we have anything to upload
    If UBound(vCards, 1) < 2 Then
        MsgBox ("Nothing to upload")
    Else
        'Get a handle for the file
        lCardFile = FreeFile()
        
        'Open the file
        Open strCardFile For Output As lCardFile
        
        'Loop thru the cards
        For L = LBound(vCards, 1) + 1 To UBound(vCards, 1) 'Skip the header row
            'Compile info of the cards
            strCard = vCards(L, 2) & vbTab & vCards(L, 3) & vbTab & vCards(L, 4) & vbTab & vCards(L, 5) & vbTab & vCards(L, 6) & vbTab & vCards(L, 7) & vbTab & vCards(L, 8) & vbTab & vCards(L, 9) & vbTab & vCards(L, 10) & vbTab & vCards(L, 10) & vbTab & vCards(L, 11) & vbTab & vCards(L, 12) & vbTab & vCards(L, 13)
            
            'Inform users of progress
            If L Mod 10000 = 0 Then
                Application.StatusBar = "Creating temporary textfile for uploading, " & L & " of " & UBound(vCards, 1) & " cards processed"
            End If
            
            'Print the card to the text file
            Print #lCardFile, strCard
        Next L
    End If
    
    'Close the text file
    Close #lCardFile
    
End Sub
 

shg

MrExcel MVP
Joined
May 7, 2008
Messages
21,779
Office Version
  1. 2010
Platform
  1. Windows
Try adding DoEvents immediately after writing to the statusbar.
 

Jaymond Flurrie

Well-known Member
Joined
Sep 22, 2008
Messages
868

ADVERTISEMENT

Try adding DoEvents immediately after writing to the statusbar.

sub credits()
msgbox "Thank you for the answer, it worked immediately!"
msgbox "end case"
end sub
 

shg

MrExcel MVP
Joined
May 7, 2008
Messages
21,779
Office Version
  1. 2010
Platform
  1. Windows
Feel inclined to see if this works faster (completely untested)?

Code:
Sub DatabaseToTXT()
    Dim vCards      As Variant      ' array of cards
    Dim iFile       As Integer      ' file number
    Dim sFile       As String       ' output filename
    Dim sOut        As String       ' output string
    Dim iRow        As Long         ' outer loop variable
    Dim jRow        As Long         ' inner loop variable
    Dim nRow        As Long         ' number of rows

    Application.StatusBar = "Creating temporary textfile for uploading"
    vCards = shtTemp.Range("A1").CurrentRegion.Resize(, 13)
    sFile = ActiveWorkbook.Path & "\cards.txt"
    nRow = UBound(vCards, 1)

    If nRow < 2 Then
        MsgBox ("Nothing to upload")

    Else
        iFile = FreeFile()
        Open sFile For Output As iFile

        With WorksheetFunction
            For iRow = 2 To nRow Step 1000
                sOut = vbNullString
                For jRow = iRow To .Min(iRow + 999, nRow)
                    sOut = sOut & vbCrLf & Join(.Index(vCards, jRow, 0), vbTab) & vbCrLf
                Next jRow

                Print #iFile, Mid(sOut, 2)
                Application.StatusBar = "Output row " & jRow & " of " & nRow
                DoEvents
            Next iRow
        End With

        Close #iFile
        Application.StatusBar = False
    End If
End Sub
 

wigi

Well-known Member
Joined
Jul 10, 2006
Messages
7,958
Office Version
  1. 365
Platform
  1. Windows
  2. Mobile
  3. Web

ADVERTISEMENT

My suggestion:

Code:
Sub DatabaseToTXT_WIGI()

    Dim strCardFile As String
    Dim strCard As String
    Dim vCards
    Dim vCards_Concat
    Dim L As Long, M As Single

    With Range("A1").CurrentRegion
        With .Resize(, .Columns.Count - 2).Offset(, 2)
            vCards = .Value
            vCards_Concat = .Columns(1).Value
        End With
    End With

    strCardFile = ActiveWorkbook.Path & "\cards.txt"
    If Len(Dir(strCardFile)) Then Kill strCardFile

    If UBound(vCards) < 2 Then
        MsgBox "Nothing to upload"
    Else
        For L = 1 To UBound(vCards)
            strCard = ""
            For M = 1 To UBound(vCards, 2)
                strCard = strCard & vbTab & vCards(L, M)
            Next
            vCards_Concat(L, 1) = Mid(strCard, 2)            
        Next
        
        Open strCardFile For Output As #1
        Print #1, Join(Application.Transpose(vCards_Concat), vbCrLf)
        Close #1
    End If
End Sub
 

shg

MrExcel MVP
Joined
May 7, 2008
Messages
21,779
Office Version
  1. 2010
Platform
  1. Windows
Reckon it depends on how much data is in those 4.5 million cells ...
 

wigi

Well-known Member
Joined
Jul 10, 2006
Messages
7,958
Office Version
  1. 365
Platform
  1. Windows
  2. Mobile
  3. Web
An improved suggestion:

Code:
Sub DatabaseToTXT_WIGI()

    Dim strCardFile As String
    Dim vCards
    Dim vCards_Concat
    Dim L As Long


    With Range("A1").CurrentRegion.Offset(1)
        With .Resize(, .Columns.Count - 2).Offset(, 2)
            vCards = .Value
            vCards_Concat = .Columns(1).Value
        End With
    End With


    strCardFile = ActiveWorkbook.Path & "\cards.txt"
    If Len(Dir(strCardFile)) Then Kill strCardFile


    If UBound(vCards) < 2 Then
        MsgBox "Nothing to upload"
    Else
        For L = 1 To UBound(vCards)
            vCards_Concat(L, 1) = Join(WorksheetFunction.Index(vCards, L, 0), vbTab)
        Next
        
        Open strCardFile For Output As #1
        Print #1, Join(Application.Transpose(vCards_Concat), vbCrLf)
        Close #1
    End If
End Sub
 
Last edited:

Rick Rothstein

MrExcel MVP
Joined
Apr 18, 2011
Messages
36,679
Office Version
  1. 2010
Platform
  1. Windows
Rich (BB code):
'Compile info of the cards
strCard = vCards(L, 2) & vbTab & vCards(L, 3) & vbTab & vCards(L, 4) & vbTab & vCards(L, 5) & vbTab & vCards(L, 6) & vbTab & vCards(L, 7) & vbTab & vCards(L, 8) & vbTab & vCards(L, 9) & vbTab & vCards(L, 10) & vbTab & vCards(L, 10) & vbTab & vCards(L, 11) & vbTab & vCards(L, 12) & vbTab & vCards(L, 13)
'
'
I presume you meant to deliberately skip the data in Column 1, but did you really mean to repeat the data from Column 10 as shown in red above?
 

Watch MrExcel Video

Forum statistics

Threads
1,122,464
Messages
5,596,288
Members
414,052
Latest member
Dual Showman

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top