Writing to an Excel file with VB6 Speed issues - excel

Question

I have code that open's up an excel file used for mapping data. Then opens up a transaction file and appends columns to the file based on the mapping data. It works however I am having speed issues, it runs slow. If I click and hold the scroll bar in Excel it speeds up but when I let up the mouse button it slows back down, thoughts?
Dim MapLocation As String
Dim MapHeader As Integer
Dim MapColumnLegacy As Integer
Dim MapColumnFE As Integer
Dim MapColumnClass As Integer
Dim MapColumnProject As Integer
Dim MapColumnTcode1 As Integer
Dim MapColumnTcode2 As Integer
Dim MapColumnTcode3 As Integer
Dim MapColumnTcode4 As Integer
Dim MapColumnTcode5 As Integer
'Dim MapLines As Integer
Dim TransLocation As String
Dim TransHeader As Integer
Dim TransLines As Integer
Dim TransColumnLegacy As Integer
Dim ConvertSheet As Integer
Dim Xl As New Excel.Application
Dim Xlsheet As Excel.Worksheet
Dim Xlwbook As Excel.Workbook
Dim OldAcctID() As String
Dim NewAcctID() As String
Dim NewProjID() As String
Dim NewClassID() As String
Dim NewTcode1ID() As String
Dim NewTcode2ID() As String
Dim NewTcode3ID() As String
Dim NewTcode4ID() As String
Dim NewTcode5ID() As String
Dim I As Integer
Dim J As Integer
Dim Sheet As Object
Sub AcctConv_Main()
Call Cleanup
Call File_Access
Call OpenExcelfile
End Sub
Sub Cleanup()
ReDim OldAcctID(TransLines) As String
ReDim NewAcctID(TransLines) As String
ReDim NewProjID(TransLines) As String
ReDim NewClassID(TransLines) As String
ReDim NewTcode1ID(TransLines) As String
ReDim NewTcode2ID(TransLines) As String
ReDim NewTcode3ID(TransLines) As String
ReDim NewTcode4ID(TransLines) As String
ReDim NewTcode5ID(TransLines) As String
I = 1
For I = 1 To TransLines
OldAcctID(I) = ""
NewAcctID(I) = ""
Next I
End Sub
Sub File_Access()
' Open Account Mapping and input the data from
' columns which contain the old and
' new data for the account mappings
'
If MapHeader = 0 Then
I = 1
Else: I = 2
End If
Xl.Workbooks.Open MapLocation
Xl.ActiveWorkbook.RunAutoMacros xlAutoOpen
For I = 1 To TransLines
OldAcctID(I) = Cells(I, MapColumnLegacy)
NewAcctID(I) = Cells(I, MapColumnFE)
If Config_Form.MapProject_Check.Value = 1 Then
NewProjID(I) = Cells(I, MapColumnProject)
End If
If Config_Form.MapClass_Check.Value = 1 Then
NewClassID(I) = Cells(I, MapColumnClass)
End If
If Config_Form.MapTcode1_Check.Value = 1 Then
NewTcode1ID(I) = Cells(I, MapColumnTcode1)
End If
If Config_Form.MapTcode2_Check.Value = 1 Then
NewTcode2ID(I) = Cells(I, MapColumnTcode2)
End If
If Config_Form.MapTcode3_Check.Value = 1 Then
NewTcode3ID(I) = Cells(I, MapColumnTcode3)
End If
If Config_Form.MapTcode4_Check.Value = 1 Then
NewTcode4ID(I) = Cells(I, MapColumnTcode4)
End If
If Config_Form.MapTcode5_Check.Value = 1 Then
NewTcode5ID(I) = Cells(I, MapColumnTcode5)
End If
Next I
Xl.ActiveWorkbook.Close False
Xl.Quit
End Sub
Sub OpenExcelfile()
Xl.Workbooks.Open (TransLocation)
ActiveWorkbook.Sheets(ConvertSheet).Activate
Xl.Visible = True
'Opens transaction document to insert columns
Call LegacyAttribute
'Insert a new Column for Attribute and renames it, renames Legacy account header as Attribute Type
Call InsertNewAccount
'Insert a new Column for FE account and renames it
Call InsertNewProject
'Insert a new Column for Project and renames it
Call InsertNewClass
'Insert a new Column for Class and renames it
Call InsertNewTcode1
'Insert a new Column for Tcode1 and renames it
Call InsertNewTcode2
'Insert a new Column for Tcode2 and renames it
Call InsertNewTcode3
'Insert a new Column for Tcode3 and renames it
Call InsertNewTcode4
'Insert a new Column for Tcode4 and renames it
Call InsertNewTcode5
'Insert a new Column for Tcode5 and renames it
Call PlugInNewAcctIDs
'save the file
Xl.ActiveWorkbook.Save
'close the file
Xl.ActiveWorkbook.Close
Xl.Quit
Convertwait_Form.Hide
Unload Convertwait_Form
MsgBox "Your Accounts Have Been Converted", vbExclamation, "Conversion Complete"
'get the next file
End Sub
Sub PlugInNewAcctIDs()
' Go back to the main XL document and
' plug in the new account numbers when a match
' to the old number is found in the first column
'
Convertwait_Form.Show
BadCell = Cells(I, 2)
I = 1
J = 1
For I = 1 To TransLines
If (Cells(I, 1) = "") And (Cells(I + 1, 1) = "") And (Cells(I + 2, 1) = "")Then
GoTo Continue
Else
For J = 1 To TransLines
If Cells(I, 1) = OldAcctID(J) Then
Cells(I, 2) = "Legacy Account"
Cells(I, 3) = NewAcctID(J)
If Config_Form.MapProject_Check.Value = 1 Then
Cells(I, 4) = NewProjID(J)
End If
If Config_Form.MapClass_Check.Value = 1 Then
Cells(I, 5) = NewClassID(J)
End If
If Config_Form.MapTcode1_Check.Value = 1 Then
Cells(I, 6) = NewTcode1ID(J)
End If
If Config_Form.MapTcode2_Check.Value = 1 Then
Cells(I, 7) = NewTcode2ID(J)
End If
If Config_Form.MapTcode3_Check.Value = 1 Then
Cells(I, 8) = NewTcode3ID(J)
End If
If Config_Form.MapTcode4_Check.Value = 1 Then
Cells(I, 9) = NewTcode4ID(J)
End If
If Config_Form.MapTcode5_Check.Value = 1 Then
Cells(I, 10) = NewTcode5ID(J)
End If
End If
If Cells(I, 3) = "" Then
Cells(I, 3) = "Missing Account Mapping"
End If
Next J
End If
If Cells(I, 3) = "Missing Account Mapping" Then
Cells(I, 3).Interior.ColorIndex = 44
Cells(I, 3).Font.Color = vbRed
End If
Next I
Continue:
End Sub

Answer 1

Here is how to do what is recommended in the comments...
Change your AcctConv_Main() routine to this:
Sub AcctConv_Main()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Call CleanUp
Call File_Access
Call OpenExcelfile
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub