VBA code takes long time to execute in excel

by

The first thing I do to speed up VBA like this is to use Screen Updating

Sub LOOK()

Application.ScreenUpdating = False

Worksheets("Input").Unprotect ("ds12345")
Dim found As Range
Set found = Sheets("Records").Columns("D").Find(What:=ActiveSheet.Cells(3, 13).Value, SearchDirection:=xlPrevious, LookIn:=xlValues, LookAt:=xlWhole)
If found Is Nothing Then
    MsgBox "Not found"
Else
    MsgBox "Found on row " & found.Row
End If

Dim iRow As Integer

iRow = InputBox("Which row?")

Worksheets("Input").Cells(2, 1).Value = Worksheets("Records").Cells(iRow, 2).Value
Worksheets("Input").Cells(4, 2).Value = Worksheets("Records").Cells(iRow, 3).Value
Worksheets("Input").Cells(3, 13).Value = Worksheets("Records").Cells(iRow, 4).Value
Worksheets("Input").Cells(4, 13).Value = Worksheets("Records").Cells(iRow, 5).Value
Worksheets("Input").Cells(10, 3).Value = Worksheets("Records").Cells(iRow, 6).Value
Worksheets("Input").Cells(3, 16).Value = Worksheets("Records").Cells(iRow, 7).Value
Worksheets("Input").Cells(9, 7).Value = Worksheets("Records").Cells(iRow, 9).Value
Worksheets("Input").Cells(12, 7).Value = Worksheets("Records").Cells(iRow, 10).Value
Worksheets("Input").Cells(13, 7).Value = Worksheets("Records").Cells(iRow, 11).Value
Worksheets("Input").Cells(9, 14).Value = Worksheets("Records").Cells(iRow, 12).Value
Worksheets("Input").Cells(94, 5).Value = Worksheets("Records").Cells(iRow, 13).Value
Worksheets("Input").Cells(95, 5).Value = Worksheets("Records").Cells(iRow, 14).Value
Worksheets("Input").Cells(97, 2).Value = Worksheets("Records").Cells(iRow, 15).Value
Worksheets("Input").Cells(20, 1).Value = Worksheets("Records").Cells(iRow, 16).Value
Worksheets("Input").Cells(21, 1).Value = Worksheets("Records").Cells(iRow, 17).Value
Worksheets("Input").Cells(22, 1).Value = Worksheets("Records").Cells(iRow, 18).Value
Worksheets("Input").Cells(23, 1).Value = Worksheets("Records").Cells(iRow, 19).Value
Worksheets("Input").Cells(24, 1).Value = Worksheets("Records").Cells(iRow, 20).Value
Worksheets("Input").Cells(25, 1).Value = Worksheets("Records").Cells(iRow, 21).Value
Worksheets("Input").Cells(26, 1).Value = Worksheets("Records").Cells(iRow, 22).Value
Worksheets("Input").Cells(27, 1).Value = Worksheets("Records").Cells(iRow, 23).Value
Worksheets("Input").Cells(28, 1).Value = Worksheets("Records").Cells(iRow, 24).Value
Worksheets("Input").Cells(29, 1).Value = Worksheets("Records").Cells(iRow, 25).Value
Worksheets("Input").Cells(30, 1).Value = Worksheets("Records").Cells(iRow, 26).Value
Worksheets("Input").Cells(31, 1).Value = Worksheets("Records").Cells(iRow, 27).Value
Worksheets("Input").Cells(32, 1).Value = Worksheets("Records").Cells(iRow, 28).Value
Worksheets("Input").Cells(33, 1).Value = Worksheets("Records").Cells(iRow, 29).Value
Worksheets("Input").Cells(34, 1).Value = Worksheets("Records").Cells(iRow, 30).Value
Worksheets("Input").Cells(20, 11).Value = Worksheets("Records").Cells(iRow, 31).Value
Worksheets("Input").Cells(21, 11).Value = Worksheets("Records").Cells(iRow, 32).Value
Worksheets("Input").Cells(22, 11).Value = Worksheets("Records").Cells(iRow, 33).Value
Worksheets("Input").Cells(23, 11).Value = Worksheets("Records").Cells(iRow, 34).Value
Worksheets("Input").Cells(24, 11).Value = Worksheets("Records").Cells(iRow, 35).Value
Worksheets("Input").Cells(42, 11).Value = Worksheets("Records").Cells(iRow, 37).Value
Worksheets("Input").Cells(43, 11).Value = Worksheets("Records").Cells(iRow, 38).Value
Worksheets("Input").Cells(44, 11).Value = Worksheets("Records").Cells(iRow, 39).Value
Worksheets("Input").Cells(45, 11).Value = Worksheets("Records").Cells(iRow, 40).Value
Worksheets("Input").Cells(46, 11).Value = Worksheets("Records").Cells(iRow, 41).Value
Worksheets("Input").Cells(47, 11).Value = Worksheets("Records").Cells(iRow, 42).Value
Worksheets("Input").Cells(48, 11).Value = Worksheets("Records").Cells(iRow, 43).Value
Worksheets("Input").Cells(58, 5).Value = Worksheets("Records").Cells(iRow, 44).Value
Worksheets("Input").Cells(59, 5).Value = Worksheets("Records").Cells(iRow, 45).Value
Worksheets("Input").Cells(60, 5).Value = Worksheets("Records").Cells(iRow, 46).Value
Worksheets("Input").Cells(58, 8).Value = Worksheets("Records").Cells(iRow, 47).Value
Worksheets("Input").Cells(59, 8).Value = Worksheets("Records").Cells(iRow, 48).Value
Worksheets("Input").Cells(60, 8).Value = Worksheets("Records").Cells(iRow, 49).Value
Worksheets("Input").Cells(58, 11).Value = Worksheets("Records").Cells(iRow, 50).Value
Worksheets("Input").Cells(59, 11).Value = Worksheets("Records").Cells(iRow, 51).Value
Worksheets("Input").Cells(60, 11).Value = Worksheets("Records").Cells(iRow, 52).Value
Worksheets("Input").Cells(58, 14).Value = Worksheets("Records").Cells(iRow, 53).Value
Worksheets("Input").Cells(59, 14).Value = Worksheets("Records").Cells(iRow, 54).Value
Worksheets("Input").Cells(60, 14).Value = Worksheets("Records").Cells(iRow, 55).Value
Worksheets("Input").Cells(65, 18).Value = Worksheets("Records").Cells(iRow, 56).Value
Worksheets("Input").Cells(104, 18).Value = Worksheets("Records").Cells(iRow, 76).Value

If [l8] = [n9] Then
    [K8] = "YES"
    End If
If [l9] = [n9] Then
    [K9] = "YES"
    End If
If [l10] = [n9] Then
    [K10] = "YES"
    End If
If [l12] = [n9] Then
    [K12] = "YES"
    End If
If [l13] = [n9] Then
    [K13] = "YES"
    End If
If [l14] = [n9] Then
    [K14] = "YES"
    End If
If [l15] = [n9] Then
    [K15] = "YES"
    End If
If [l16] = [n9] Then
    [K16] = "YES"
    End If
If [l17] = [n9] Then
    [K17] = "YES"
End If

Worksheets("Input").Protect ("ds12345")

Application.ScreenUpdating = True

End Sub

For the cleanliness of the code I would make secondary loops when you have lots of values that incrementally increase such as:

Worksheets("Input").Cells(42, 11).Value = Worksheets("Records").Cells(iRow, 37).Value
Worksheets("Input").Cells(43, 11).Value = Worksheets("Records").Cells(iRow, 38).Value
Worksheets("Input").Cells(44, 11).Value = Worksheets("Records").Cells(iRow, 39).Value 
Worksheets("Input").Cells(45, 11).Value = Worksheets("Records").Cells(iRow, 40).Value
Worksheets("Input").Cells(46, 11).Value = Worksheets("Records").Cells(iRow, 41).Value
Worksheets("Input").Cells(47, 11).Value = Worksheets("Records").Cells(iRow, 42).Value
Worksheets("Input").Cells(48, 11).Value = Worksheets("Records").Cells(iRow, 43).Value

We don’t have the data so it is hard to say if there was a more efficient way of selecting, but I imagine that using a copy and paste special value would be much quicker for most of this.

More Related Contents:

  1. VBA – How to grab the cell below if a cell has text?
  2. Loop through files in a folder using VBA?
  3. How to error handle 1004 Error with WorksheetFunction.VLookup?
  4. How to compare two entire rows in a sheet
  5. how to detect whether VBA excel found something?
  6. Excel tab sheet names vs. Visual Basic sheet names
  7. Saving a Excel File into .txt format without quotes
  8. Excel VBA “Method ‘Document’ of object ‘IWebBrowser2’ failed”
  9. Determine if cell contains data validation
  10. Fastest way to delete rows which cannot be grabbed with SpecialCells
  11. Combine multiple Excel workbooks into a single workbook
  12. Excel Macro, inserting internationally valid formula during run-time
  13. Sheet protection: UserInterFaceOnly gone
  14. VBScript – How to make program wait until process has finished?
  15. Consolidating worksheets into one
  16. Copy filtered data to another sheet using VBA
  17. Range.Find on a Date That is a Formula
  18. TextJoin UDF For Excel 2013
  19. Range() vs Cells() vs Range.Cells()
  20. Open an Excel file from SharePoint site
  21. How to get address of cell which calls a VBA Functions in a Excel sheet
  22. How do I open a file if I only know part of the file name?
  23. VBA Function argument list select
  24. VBA recognizing workbook by partial name
  25. Calling regasm without administrative rights for COM interop in Excel VBA
  26. Is there a way for DIR(path) in VBA to handle strings longer than 260?
  27. How do I activate a specific workbook and a specific sheet?
  28. VBA Run-time error 438 appears when “paste” runs
  29. If Not function proceeds when value *is* the one specified
  30. Copy an entire worksheet to a new worksheet in Excel 2010

Leave a Comment