Hi guys
I am running a simple VBA macro which has 2 loops, and opens a source file, copies data to a target workbook, and then closes both files. The macro suddenly stops in the middle of execution - no warning or error message. I tried it a few times. There is no pattern to suggest that it stops at a certain trigger or step. Sometimes it stops and I can see the source workbook open. Sometimes it stops and only my Macro workbook is open. Sometimes it stops and all 3 files are open. This means it stops anywhere in the code execution.
I use the first loop to iterate through each source file, and then use the second loop to iterate through column headings.
Any ideas why this occurs and how to fix it?
I've seen a few threads which suggest that this "random stopping" is actually a common occurrence. However, the solutions seem really wild - some talk about changing the position of the scroll bar, Bob Umlas stated that he adds "Do Events" at random points in the sub, one suggestion gives a sequence of key presses with Ctrl+Esc. But all seem to be hit and miss.
Here is my code
I am running a simple VBA macro which has 2 loops, and opens a source file, copies data to a target workbook, and then closes both files. The macro suddenly stops in the middle of execution - no warning or error message. I tried it a few times. There is no pattern to suggest that it stops at a certain trigger or step. Sometimes it stops and I can see the source workbook open. Sometimes it stops and only my Macro workbook is open. Sometimes it stops and all 3 files are open. This means it stops anywhere in the code execution.
I use the first loop to iterate through each source file, and then use the second loop to iterate through column headings.
Any ideas why this occurs and how to fix it?
I've seen a few threads which suggest that this "random stopping" is actually a common occurrence. However, the solutions seem really wild - some talk about changing the position of the scroll bar, Bob Umlas stated that he adds "Do Events" at random points in the sub, one suggestion gives a sequence of key presses with Ctrl+Esc. But all seem to be hit and miss.
Here is my code
VBA Code:
Sub CopyData()
Dim Starttime As String
Dim EndTime As String
Starttime = Time
Dim strSheetName As String
Dim strFileName As String
Dim strFilePath As String
Dim strDestPath As String
Dim Fullpath As String
Dim ImportSortCode As String
Dim IndexWkbk As Workbook ‘Index workbook contains list of source filenames, filepaths, and wb sheetnames
Dim LstRow As Long
Dim LstRow2 As Long
Dim LstCol2 As Long
Dim strCompCode As String
Dim lngHeaderRow As Long
Dim rngWBSHeader As Range
Dim SearchTerm As String
Dim ws As Worksheet
Dim Wb As Workbook ‘source workbook
Dim wbT As Workbook ‘target workbook
Dim lngTargetAdd As Range
Dim lngTargetCol As Long
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Set IndexWkbk = ActiveWorkbook
IndexWkbk.Activate
Worksheets("CoLookup").Select
For i = 1 To 700 ‘using set range to loop through files. Data starts at row 4, thus use i+3 to reference each row
ImportSortCode = Range("AR" & i + 3).Text 'get importsortcode value. This is the naming convention used for the target file and will be used to push data to the target file.
strSheetName = Range("B" & i + 3).Text ‘get source sheetname from index workbook
strFileName = Range("A" & i + 3).Text ‘get source filename from index workbook
strFilePath = Range("P" & i + 3).Text ‘get source filepath from index workbook
strDestPath = "C:\AR Analysis\" & ImportSortCode & ".xlsm" ‘target Excel file already exists with a naming convention
Fullpath = Range("C" & i + 3).Text ‘get source file full path (dir & filename)
strCompCode = Range("T" & i + 3).Text 'determine search term according to Index workbook
'open source workbook as Read-Only
Set Wb = Workbooks.Open(FileName:=Fullpath, UpdateLinks:=False, ReadOnly:=True)
Wb.Sheets(strSheetName).Select ‘navigate to source sheet
'search for CoCode to determine headingrow, then find last row and last column
lngHeaderRow = Cells.Find(what:=strCompCode, After:=Range("A1"), LookIn:=xlFormulas2, _
lookat:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Row
LstRow = Range("A" & lngHeaderRow).End(xlDown).Row
'copy headings across from indexworkbook
IndexWkbk.Activate
Sheets("CoLookup").Range("T" & i + 3 & ":AQ" & i + 3).Copy
Wb.Activate ‘replace headings in source workbook
Wb.Sheets(strSheetName).Select
Range("a" & lngHeaderRow).Select
Range("a" & lngHeaderRow).PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
'open Target workbook
Set wbT = Workbooks.Open(FileName:=strDestPath, UpdateLinks:=False, ReadOnly:=False)
wbT.Activate
Sheets("Sheet1").Select
LstRow2 = Cells(Rows.Count, "EB").End(xlUp).Row 'Find last used row
LstCol2 = 131 'hardcode to column EA
'iterate through each column to copy-paste data
For j = 1 To LstCol2
SearchTerm = wbT.Sheets("Sheet1").Cells(1, j).Text 'obtain each search term from each column in target workbook row1
Wb.Activate ‘search for column in source workbook, then copy data from that column back into target workbook
Wb.Sheets(strSheetName).Select
'search for search term in source header row
Set rngWBSHeader = Range(lngHeaderRow & ":" & lngHeaderRow).Find(what:=SearchTerm, After:=Range("A" & lngHeaderRow), LookIn:=xlFormulas, _
lookat:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
If Not rngWBSHeader Is Nothing Then
Range(Cells(lngHeaderRow + 1, rngWBSHeader.Column), Cells(LstRow, rngWBSHeader.Column)).Copy 'copy data from column
wbT.Activate
Sheets("Sheet1").Select
Cells(LstRow2 + 1, j).Select 'go to last used row, and select one below
Selection.PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
End If
Set rngWBSHeader = Nothing 'clear memory
Next j
wbT.Activate ‘use this in case rngWBSHeader is nothing
Sheets("Sheet1").Select
‘insert source data filename and sheetname
Range("EB" & LstRow2 + 1 & ": EB" & LstRow2 + 1 + LstRow - lngHeaderRow - 1).FormulaR1C1 = Fullpath
Range("EC" & LstRow2 + 1 & ": EC" & LstRow2 + 1 + LstRow - lngHeaderRow - 1).FormulaR1C1 = strSheetName
wbT.Save
wbT.Close
Wb.Close SaveChanges:=False 'close source, no changes
IndexWkbk.Activate ‘do I need this line to return to the IndexWorkbook?
Worksheets("CoLookup").Select
‘create labels to show which lines have been processed
Debug.Print i
Range("AW" & i + 3).FormulaR1C1 = "ok" 'log which item has been cleared
Range("AX" & i + 3).FormulaR1C1 = lngHeaderRow 'source sheet table header row
Range("AY" & i + 3).FormulaR1C1 = LstRow 'source sheet table last row
'clear memory
Set rngWBSHeader = Nothing
Set Wb = Nothing
Set wbT = Nothing
Next i
Application.ScreenUpdating = True
Application.DisplayAlerts = True
EndTime = Time
MsgBox "Done" & vbCrLf & Starttime & vbCrLf & EndTime
End Sub
