Make VBA project run more efficient

Question

I am a very new coder in VBA (and in general). I have managed to write some code to check a coordinate file with value in an Excel sheet, and use the coordinate to verify the value in the relevant file coordinate location (the range specified by the coordinate file). My problem is that there are more than 10000 lines to check that involves more than 100 Excel files.

The run time of the macro is more than 2 hours.

I have tried to set screen update off, etc., to make it faster but it seems not to be helping much.

Could anyone suggest how I can make it run more efficiently?

Main code

Sub Output_varification()
 
'input folder path for the Axiom output
 
Dim Folderpath As String
 
    With Application.FileDialog(msoFileDialogFolderPicker)
        .Title = "Select A Target Folder"
        .AllowMultiSelect = False
        If .Show = -1 Then
            Folderpath = .SelectedItems(1) & "\"
        End If
    End With
       
    
    If Folderpath <> "" Then
    'MsgBox Folderpath
   
    Else
    MsgBox "no folder chosen"
   
    End If
 
'find the starting point of the output file
 
Dim Start As Range
 
Dim choice As Variant
 
choice = MsgBox("Do you want to start from scratch?", vbYesNo, "Starting point")
 
If choice = 7 Then
 
    Set Start = Application.InputBox("choose the template line on template number cell (should be column B)", "Input", Type:=8)
'MsgBox Start.Value
 
Else
Set Start = ActiveSheet.Range("A:F").Find(what:="Template", LookIn:=xlValues)
 
End If
 
Application.ScreenUpdating = False
 
While Start.Offset(1, 0).Value <> ""
   
    Call Reading_Coordinates(Start.Offset(1, 0), Folderpath)
   
    Set Start = Start.Offset(1, 0)
 
Wend
 
Application.ScreenUpdating = True
 
MsgBox "Task complete!"
 
End Sub

Sub Function 1

Private Sub Reading_Coordinates(Line As Range, File As String)
 
'Line As Range, File As String
 
Dim Filepath As String
Dim ctemplate As Workbook
 
Dim Temp_number As String
Dim Sheet_number As String
Dim Row_number As String
Dim Column_number As String
Dim Amount As Variant
 
'test
'Set Line = Range("b2")
'File = "\\fwlnp006vf.ln.fw.gs.com\zjunli\home\Desktop\Template Hub project\Axiom output\GSI output\"
'MsgBox File
 
'Read data in one line in Axiom output
 
If Temp_number <> Line.Value Then
 
    Temp_number = Line.Value
    Sheet_number = Line.Offset(0, 1).Value
    Row_number = Line.Offset(0, 2).Value
    Column_number = Line.Offset(0, 3).Value
    Amount = Line.Offset(0, 4).Value
   
    'MsgBox Temp_number & Sheet_number & Row_number & Column_number & Amount
   
    'open the file with the template number
    'Note wonn't work for template more than 1 part
   
    If Temp_number <> "F_40_0*" Then
   
        Filepath = Dir(File & "*" & Temp_number & "*.xlsx")
       
        'MsgBox Filepath
        On Error Resume Next
        Set ctemplate = Workbooks.Open(File & Filepath)
       
            Call Get_Cell(Row_number, Column_number, Filepath)
            If Get_Cell(Row_number, Column_number, Filepath).Value <> Amount Then
                Line.Offset(0, 4).Interior.Color = 65535
                Line.Offset(0, 5).Value = Get_Cell(Row_number, Column_number, Filepath).Value
            End If
           
            Workbooks(Filepath).Close (False)
   
    End If
  
Else
    Sheet_number = Line.Offset(0, 1).Value
    Row_number = Line.Offset(0, 2).Value
    Column_number = Line.Offset(0, 3).Value
    Amount = Line.Offset(0, 4).Value
       
          Call Get_Cell(Row_number, Column_number, Filepath)
            If Get_Cell(Row_number, Column_number, Filepath).Value <> Amount Then
                Line.Offset(0, 4).Interior.Color = 65535
                Line.Offset(0, 5).Value = Get_Cell(Row_number, Column_number, Filepath).Value
            End If
   
End If
 
End Sub

Sub function 2

Private Function Get_Cell(xrow As String, xcolumn As String, ftemplate As String) As Range
 
Dim findrow As Range
Dim findcolumn As Range
 
Set findrow = Workbooks(ftemplate).Worksheets(1).Range("C:C").Find(what:=xrow, LookIn:=xlValues)
Set findcolumn = Workbooks(ftemplate).Worksheets(1).Range("D:AZ").Find(what:=xcolumn, LookIn:=xlValues)
 
Set Get_Cell = Cells(findrow.row, findcolumn.column)
 
End Function

Answer 1

Untested, but a few ideas here:

1. Re-use the already-opened file is it's the same source. Your code doesn't quite do this because Temp_number (among others) gets wiped between calls
2. Move the main loop into Reading_Coordinates
3. Moved your lookup function into the main sub

'call with Line = first cell to process
Private Sub Reading_Coordinates(Line As Range, File As String)
 
    Dim ctemplate As Workbook
    Dim Temp_number As String
    Dim Sheet_number As String
    Dim Row_number As String
    Dim Column_number As String
    Dim Amount As Variant, v, f, m, amt, findcolumn As Range
   
    'main loop is now here   
    Do While Len(Line.Value) > 0
        
        v = Line.Value
        
        If Temp_number <> v Then 'new source file?
            If Not ctemplate Is Nothing Then ctemplate.Close False 'close previous
            If Not v Like "F_40_0*" Then
                f = Dir(File & "*" & v & "*.xlsx")
                If Len(f) > 0 Then
                    Set ctemplate = Workbooks.Open(File & f, ReadOnly:=True)
                End If
            End If
            Temp_number = v
        End If
        
        If Not ctemplate Is Nothing Then
            
            Sheet_number = Line.Offset(0, 1).Value
            Row_number = Line.Offset(0, 2).Value
            Column_number = Line.Offset(0, 3).Value
            Amount = Line.Offset(0, 4).Value
            
            With ctemplate.Worksheets(1)
                m = Application.Match(Row_number, .Columns("C"), 0) 'match is faster...
                If Not IsError(m) Then
                    Set findcolumn = .Range("D:AZ").Find(what:=Column_number, LookIn:=xlValues)
                    If Not findcolumn Is Nothing Then 'Find got a match
                        amt = .Cells(m, findcolumn.Column).Value
                        If amt <> Amount Then
                            Line.Offset(0, 4).Interior.Color = 65535
                            Line.Offset(0, 5).Value = amt
                        End If
                    End If
                End If 'got a col C match
            End With
            
        End If 'have a file to look at
        
        Set Line = Line.Offset(1, 0) 'next cell
    Loop
End Sub