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!