Retrieve value from a formula in cells into different merged cells and retrieved value can be edited

Question

I have created this macro and having a small issue. I am very new to this VBA and did this with experts’ guides by googling it. I am creating an excel form for a work purpose at work. The Excel form has 7 sheets and each have named tables with different data.

• 1st sheet is the editable form, which retrieves data from the tables in the different sheets. This is the only visible sheet, and other sheets are protected and hidden,
• 1st sheet has hidden rows and columns those have logical formulas that assist me to retrieve my data from the other tables, so cells with formulas (mostly-vlookup, index, match, if, or) are in those rows and columns.
• I want the user to edit on the retrieved data, which is kind of suggestion to the user for to use it as-is or edit on it if required.
• I cannot write vlookup or loop kind of events, so I created below macro that allows me to retrieve the value of the formula as a text (not editable) in different cell, then retrieve that text to another merged and named cell as editable text.
• This macro works fine, but when I add more and more data into the Excel and add other macros, then it is quit slow.

Is it possible to this and make it function faster?

This macro applies to Sheet 1.

Private Sub Worksheet_Change(ByVal Target As Range)
    'Value as text - kind of copy+pastespecial
    If Range("F17").Value <> Range("E17").Text Then
        Range("F17").FormulaR1C1 = Range("E17")
        Range("func_R").FormulaR1C1 = Range("F17")
             'func_R and other cells below with "_R" are my merged and main cells that users will see. E17 has a vlookup formula that retrieve data from a table in Sheet 2, with this macro I copy and pastpecial the formula in E17 in F17 as a text. Then to make it editable text I copy and paste it into the merged cell with "_R".Texts in cells with "_R" come from same table in sheet 2.  
        ElseIf Range("F18").Value <> Range("E18").Text Then
            Range("F18").FormulaR1C1 = Range("E18")
            Range("job_R").FormulaR1C1 = Range("F18")
        ElseIf Range("F20").Value <> Range("E20").Value Then
            Range("F20").FormulaR1C1 = Range("E20")
            Range("purp_R").FormulaR1C1 = Range("F20")
        ElseIf Range("F22").Value <> Range("E22").Value Then
            Range("F22").FormulaR1C1 = Range("E22")
            Range("duty_R").FormulaR1C1 = Range("F22")
        ElseIf Range("F25").Value <> Range("E25").Value Then
            Range("F25").FormulaR1C1 = Range("E25")
            Range("ikey_R").FormulaR1C1 = Range("F25")
        ElseIf Range("F26").Value <> Range("E26").Value Then
            Range("F26").FormulaR1C1 = Range("E26")
            Range("ekey_R").FormulaR1C1 = Range("F26")
        ElseIf Range("F28").Value <> Range("E28").Value Then
            Range("F28").FormulaR1C1 = Range("E28")
            Range("iimp_R").FormulaR1C1 = Range("F28")
        ElseIf Range("F29").Value <> Range("E29").Value Then
            Range("F29").FormulaR1C1 = Range("E29")
            Range("eimp_R").FormulaR1C1 = Range("F29")
        'Generel requirement - it is basicly same as above, but data comes from different table in Sheet 3.
        ElseIf Range("F31").Value <> Range("E31").Value Then
            Range("F31").FormulaR1C1 = Range("E31")
            Range("req_1").FormulaR1C1 = Range("F31")
        ElseIf Range("F32").Value <> Range("E32").Value Then
            Range("F32").FormulaR1C1 = Range("E32")
            Range("req_2").FormulaR1C1 = Range("F32")
        ElseIf Range("F33").Value <> Range("E33").Value Then
            Range("F33").FormulaR1C1 = Range("E33")
            Range("req_3").FormulaR1C1 = Range("F33")
        ElseIf Range("F34").Value <> Range("E34").Value Then
            Range("F34").FormulaR1C1 = Range("E34")
            Range("req_4").FormulaR1C1 = Range("F34")
        ElseIf Range("F35").Value <> Range("E35").Value Then
            Range("F35").FormulaR1C1 = Range("E35")
            Range("req_5").FormulaR1C1 = Range("F35")
        End If
    End Sub

Answer 1

I use these two methods when running macros that do intensive work of reading/writing information to several sheets:

' hide the mouse pointer, which in some PCs makes macros very slow. put this at the top
' of your module
Private Declare PtrSafe Function ShowCursor Lib "USER32" (ByVal fShow As Integer) As Integer

' disable some Excel features while the macro is running to improve performance
Sub enableMacroOptimizations()

    Dim cursorCount As Integer

    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Application.EnableEvents = False
    Application.DisplayScrollBars = False
    ActiveWindow.DisplayWorkbookTabs = False
    Application.DisplayStatusBar = True
    Do
        cursorCount = ShowCursor(False)
    Loop While (cursorCount >= 0)

End Sub

' enable Excel features disabled with enableMacroOptimizations()
Sub disableMacroOptimizations()

    Dim cursorCount As Integer

    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    Application.EnableEvents = True
    Application.DisplayScrollBars = True
    ActiveWindow.DisplayWorkbookTabs = True
    Application.DisplayStatusBar = True
    Do
        cursorCount = ShowCursor(True)
    Loop While (cursorCount < 0)

End Sub

This will improve the performance of your macros no matter what. We have used this code to reduce macro times from more than 10 minutes to just a few seconds.

Just call enableMacroOptimizations() at the top of you own intensive method, and then call disableMacroOptimizations() at the end (to leave the user workspace as found initially).

Answer 2

This may not be any faster, but it will certainly be easier to understand and work with.

EDIT: my original code forced the logic to check every single combination, but the OP's code would stop once an inequivalence was found. The mod below changes the Sub to a Function to help skip unnecessary checks.

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim thisWS As Worksheet
    Set thisWS = thisworksheet

    If CheckAndCopy(thisWS, 17, "func_R") Then Exit Sub
    If CheckAndCopy(thisWS, 18, "job_R" ) Then Exit Sub
    If CheckAndCopy(thisWS, 20, "purp_R") Then Exit Sub
    If CheckAndCopy(thisWS, 22, "duty_R") Then Exit Sub
    If CheckAndCopy(thisWS, 25, "ikey_R") Then Exit Sub
    If CheckAndCopy(thisWS, 26, "ekey_R") Then Exit Sub

End Sub

Private Function CheckAndCopy(ByRef ws As Worksheet, _
                              ByVal iRow As Integer, _
                              ByVal rangeName As String) as Boolean
    With ws
        If .Cells(iRow, 6).Value <> .Cells(iRow, 5).Text Then
            .Cells(iRow, 6).FormulaR1C1 = .Cells(iRow, 5)
            .Range(rangeName).FormulaR1C1 = .Cells(iRow, 6)
            CheckAndCopy = True
        Else
            CheckAndCopy = False
        End If
    End With
End Sub

Answer 3

Better put the ActiveWindow.DisplayWorkbookTabs = True/False before the .ScreenUpdating=True/False or the tabs will remain visible during macro execution, and then disappear when the macro ends... at least, this is how it works for me in Office 365 i.e.

at start

ActiveWindow.DisplayWorkbookTabs = False
Application.ScreenUpdating = False

at end

ActiveWindow.DisplayWorkbookTabs = True
Application.ScreenUpdating = True

Similarly for the scrollbars, they will only consistently hide/show when put before the .ScreenUpdating=False/True.