I've written a perl script that creates a csv file consolidated of values from multiple files. This file that I've created is then used to update certain rows in a main excel spreadsheet my company uses. I've created a VBA script that scans the main file for values that match up with those from my perl generate file and it all works fine.
The problem is that it takes about four minutes to run. The main file is only about 1000 or so rows long, and the file I'm generating only comes out to about 100 rows top. My logic in my script is to scan through every row in the main file for each row in the generated file:
Sub TransferDataToForecast()
Dim strPath As String 'File path
Dim foreb As Workbook 'Workbook that the file path points to
Dim copys As Worksheet 'Worksheet that contains the data to be copied
Dim dests As Worksheet 'Worksheet that is being copied to
Dim copysLastRow As Long 'Last row of data worksheet
Dim copysLastCol As Long 'Last column of data worksheet
Dim destsLastRow As Long 'Last row of target worksheet
Dim counter As Long 'Counter for loop control
Application.ScreenUpdating = False
Set copys = ActiveWorkbook.ActiveSheet
'Get user to select target workbook
strPath = BrowseForFile("Select the DM Forecast file you want to update")
If strPath = vbNullString Then Exit Sub
'Debug.Print strPath
Set foreb = Workbooks.Open(strPath)
Set dests = foreb.Worksheets("Material_Usage_Prim")
'Get last row of each worksheet and last column of data sheet in order to help with loop control
copysLastRow = copys.Cells(Rows.Count, 3).End(xlUp).Row
copysLastCol = copys.Cells(2, Columns.Count).End(xlToLeft).Column
destsLastRow = dests.Cells(Rows.Count, 1).End(xlUp).Row
counter = 0
'Loop through each row of the data sheet
For i = 2 To copysLastRow
Debug.Print "i is "; i
'For each row in the data sheet, loop through every row in the destination sheet in order
'to find matching id's between each sheet
For j = 2 To destsLastRow
Debug.Print "j is "; j
If Trim(copys.Cells(i, 3).Value2) = vbNullString Then Exit For 'This exits the loop if the data sheet has a blank row
If dests.Cells(j, 4) <> copys.Cells(i, 4) Then GoTo NextDestLoop 'This skips the rest of the current j if values in col4 of each sheet don't match up
'Have to use replace due to differing naming conventins among people i.e. _ vs - (this row can be changed for specific peoples needs)
'This checks that columns 3 and 4 of each sheet match
If Replace(copys.Cells(i, 3).Value2, "_", "") = Replace(dests.Cells(j, 3).Value2, "_", "") And copys.Cells(i, 4).Value2 = dests.Cells(j, 4).Value2 Then
counter = 0
For k = 5 To copysLastCol
Debug.Print "k is "; k
'Go to 14, because we want to keep the first 14 weeks (columns)
If counter < 14 Then
counter = counter + 1
GoTo NextIteration
End If
counter = counter + 1
dests.Cells(j, k).Value2 = copys.Cells(i, k).Value2
NextIteration:
Next k
End If
If counter = copysLastRow Then GoTo NextLoop
NextDestLoop:
Next j
NextLoop:
Next i
Application.ScreenUpdating = True
MsgBox ("Data has been transferred.")
End Sub
'This function brings up a window for the user to pick an excel file they want to update
Private Function BrowseForFile(Optional strTitle As String) As String
Dim fDialog As FileDialog
On Error GoTo Err_handler
Set fDialog = Application.FileDialog(msoFileDialogFilePicker)
With fDialog
.Title = strTitle
.Filters.Add "Excel Files", "*.xlsx; *.xlsm; *.xls; *.xlsb", 1
.AllowMultiSelect = False
.InitialView = msoFileDialogViewList
If .Show <> -1 Then GoTo Err_handler:
BrowseForFile = fDialog.SelectedItems.Item(1)
End With
lbl_Exit:
Exit Function
Err_handler:
BrowseForFile = vbNullString
Resume lbl_Exit
End Function
If anyone can help me to make this more efficient I would be grateful!