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

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


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


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
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).

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.