title: Speeding Up the VBA Code
body: <p>I am having troubled times with my code which is basically matching the reference numbers from two workbooks and writing the related information to a new worksheet. First of all, let me give some details about the sizes. One of the workbooks has 1987 rows and 66 columns and the other one has 15645 rows and 13 columns. The new worksheet after the code has 5643 rows and 41 columns. On average code runs for 2 minutes and 10 seconds which is too long in my case. I've tried several things to speed up my code, however, it didn't work out. Thanks a lot for any kind of help!</p>
  
  <pre><code>   Sub take_swap_values()
  
     With Application
                  .ScreenUpdating = False
                  .DisplayStatusBar = False
                  .Calculation = xlCalculationManual
                  .EnableEvents = False
     End With
  
  
      Dim h, f As Long
      Dim r As Integer
  
      h = Application.WorksheetFunction.Count(Workbooks("swap.xlsx").Sheets("Sheet3").Range("$B$2:$B$1987"))
      f = Application.WorksheetFunction.Count(Workbooks("swp_fwd.xlsm").Sheets("Sheet1").Range("$A$2:$A$5645"))
  
      Workbooks("swap.xlsx").Activate
      Workbooks("swp_fwd.xlsm").Activate
      Workbooks("swp_fwd.xlsm").Sheets("Sheet2").Cells(1, 1).Value = Workbooks("swp_fwd.xlsm").Sheets("Sheet1").Cells(1, 1).Value
  
      For i = 1 To h
          For j = 1 To f
              If Workbooks("swap.xlsx").Sheets("Sheet3").Cells(i, 2).Value = Workbooks("swp_fwd.xlsm").Sheets("Sheet1").Cells(j, 1).Value Then
                  For k = 1 To 40
                      Workbooks("swp_fwd.xlsm").Sheets("Sheet2").Cells(j, k).Value = Workbooks("swap.xlsx").Sheets("Sheet3").Cells(i, k)
                  Next k
              End If
          Next j
      Next i
  
     With Application
         .ScreenUpdating = True
         .DisplayStatusBar = True
         .Calculation = xlCalculationAutomatic
         .EnableEvents = True
     End With
  
  End Sub
  </code></pre>