Formula Copy/Fill-Down Until Last Row

[menajaro]

Hello Mr. Hans
Unfortunately, but it's taking a bit longer than I expected.Thank you for your patience.

[HansV]

If you want more help, we'd need to know the actual formulas...

[menajaro]

Hello Mr. Hans
I think that your request has nothing to do with helping me because not allowed to publish any original files across the Web.
So please accept my apologies ... Thanks for any help you may have.

[HansV]

I fully understand that you cannot attach the original workbook, but without knowing the formulas I have no idea whether the code could be improved.

[menajaro]

Thank you very much Mr. Hans ... I really appreciate your help in this regard.
regarding your request about the formulas used may not be complicated. but it is many.
The code works perfectly and it gives exact results .. the only problem is that it takes long long time to execute
I hope I can find solution to my problem ... Thanks all for any help I get.

[Doc.AElstein]

These “VBA array” type coding equivalents are doing almost the same thing as the penultimate macro from Hans, especially my first Sub ConvertingFormulasToValues2()
( My second macro , Sub ConvertingFormulasToValues3() , is doing something a bit different and might not give the results you want )
They may or may not work for a large row size. If they do work, my guess is that there will not be much difference in speed, since the interaction with the worksheet will be similar to Hans macros.
But worth a quick try, just as an alternative.

( I also agree that a full consideration of VBA alternatives is only possible knowing the formulas.
Our solutions are restricted to handling the formulas, which limits the alternative ways to doing the same without formulas )

“VBA Array” type alternatives are usually quicker because they reduce the interaction with the worksheet. But in this situation the interaction is about the same, so my guess is that the performance will be similar. It might even be slightly worse. I don't know for sure.
( If my second macro works, does what you want, and works faster, then the way of Hans macro modified to do the same would, I expect also perform quicker )

Alan

( P.S. Don’t forget to copy also Public Function CL()
( Best click on SELECT ALL to get entire coding in the forum code window selected, then copy ) )

Code: Select all

Sub ConvertingFormulasToValues2()
Dim Ws As Worksheet, Rng As Range, Clm As Range, lRow As Long
Const fRow As Long = 6: Const sRow As Long = 8
 Set Ws = ThisWorkbook.Worksheets("data")
 On Error Resume Next
 Set Rng = Ws.Rows(fRow).SpecialCells(xlCellTypeFormulas)
 On Error GoTo 0
    If Rng Is Nothing Then MsgBox "No formulas!": Exit Sub
 Let lRow = Ws.Cells.Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
 Let Application.ScreenUpdating = False
    For Each Clm In Rng.Areas
    Dim arrIn() As Variant
        If Clm.Columns.Count = 1 Then
         ReDim arrIn(1 To 1, 1 To 1): Let arrIn(1, 1) = Clm.FormulaR1C1
        Else
         Let arrIn() = Clm.FormulaR1C1
        End If
    Dim arrOut() As Variant
    Dim Rws() As Variant: Let Rws() = Evaluate("=ROW(1:" & lRow - sRow + 1 & ")/ROW(1:" & lRow - sRow + 1 & ")")
    Dim Clms() As Variant: Let Clms() = Evaluate("=COLUMN(A:" & CL(UBound(arrIn(), 2)) & ")")
     Let arrOut() = Application.Index(arrIn(), Rws(), Clms())
'     Clm.Copy
        With Clm.Offset(sRow - fRow).Resize(lRow - sRow + 1)
'         .PasteSpecial Paste:=xlPasteFormulas
         .Value = arrOut()
         .Value = .Value
        End With
    Next Clm
 Let Application.ScreenUpdating = True
End Sub

Sub ConvertingFormulasToValues3()
Dim Ws As Worksheet, Rng As Range, Clm As Range, lRow As Long
Const fRow As Long = 6: Const sRow As Long = 8
 Set Ws = ThisWorkbook.Worksheets("data")
' On Error Resume Next
' Set Rng = Ws.Rows(fRow).SpecialCells(xlCellTypeFormulas)
' On Error GoTo 0
'    If Rng Is Nothing Then MsgBox "No formulas!": Exit Sub
 Let lRow = Ws.Cells.Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
'    For Each Clm In rng.Areas
Dim arrIn() As Variant: Let arrIn = Ws.Range("H6:U6").FormulaR1C1
Dim arrOut() As Variant
Dim Rws() As Variant: Let Rws() = Evaluate("=ROW(1:" & lRow - sRow + 1 & ")/ROW(1:" & lRow - sRow + 1 & ")")
Dim Clms() As Variant: Let Clms() = Evaluate("=COLUMN(A:" & CL(UBound(arrIn(), 2)) & ")")
 Let arrOut() = Application.Index(arrIn(), Rws(), Clms())
'     Clm.Copy
    With Ws.Range("H6:U6").Offset(sRow - fRow).Resize(lRow - sRow + 1)
'         .PasteSpecial Paste:=xlPasteFormulas
     .Value = arrOut()
     .Value = .Value
    End With
'    Next Clm
End Sub




'  Ref  http://www.eileenslounge.com/viewtopic.php?f=30&t=34217
'       http://www.eileenslounge.com/viewtopic.php?f=30&t=31687&p=245233#p245274

'     http://www.excelfox.com/forum/showthread.php/1546-TESTING-Column-Letter-test-Sort
Public Function CL(ByVal lclm As Long) As String '         http://www.excelforum.com/development-testing-forum/1101544-thread-post-appendix-no-reply-needed-please-do-not-delete-thanks-4.html#post4213980
    Do: Let CL = Chr(65 + (((lclm - 1) Mod 26))) & CL: Let lclm = (lclm - (1)) \ 26: Loop While lclm > 0
End Function

[Doc.AElstein]

Another way, just done for one column, as example, to give you another idea possibility

Code: Select all

'  http://www.eileenslounge.com/viewtopic.php?f=30&t=34504&start=20#p267949
Sub WriteFormulas() ' Relative formulas   https://teylyn.com/2017/03/21/dollarsigns/#comment-191
Dim Ws As Worksheet, Rng As Range, Clm As Range, lRow As Long
Const fRow As Long = 6: Const sRow As Long = 8
 Set Ws = ThisWorkbook.Worksheets("data")
 Let lRow = Ws.Cells.Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
 Set Ws = ThisWorkbook.Worksheets("data")
 Let Application.ScreenUpdating = False
 '  Formula example  -  =IF(OR(G6="eileenslounge";G6="eileenslounge1";G6="eileenslounge2");1000;"")
 Let Ws.Range("H6").Offset(sRow - fRow).Resize(lRow - sRow + 1).Value = "=IF(OR(G6=""eileenslounge"",G6=""eileenslounge1"",G6=""eileenslounge2""),1000,"""")"
 Let Ws.Range("H6").Offset(sRow - fRow).Resize(lRow - sRow + 1).Value = Ws.Range("H6").Offset(sRow - fRow).Resize(lRow - sRow + 1).Value
 Let Application.ScreenUpdating = True
End Sub

( If there were lots of formulas in a row, you could automate taking them in with VBA to avoid having to hard code them in. That extra coding would be simple and would not effect performance much.)

[menajaro]

Welcome Mr. Hans
Welcome Mr. Alan
I appreciate all your efforts to help me.
second macro I tested it on the real data and it takes only 50 seconds Instead of two minutes.

Code: Select all

Option Explicit
Sub ConvertingFormulasToValues2()
Dim Ws As Worksheet, Rng As Range, Clm As Range, lRow As Long
Const fRow As Long = 6: Const sRow As Long = 8
 Set Ws = ThisWorkbook.Worksheets("data")
 On Error Resume Next
 Set Rng = Ws.Rows(fRow).SpecialCells(xlCellTypeFormulas)
 On Error GoTo 0
    If Rng Is Nothing Then MsgBox "No formulas!": Exit Sub
 Let lRow = Ws.Cells.Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
 Let Application.ScreenUpdating = False
    For Each Clm In Rng.Areas
    Dim arrIn() As Variant
        If Clm.Columns.Count = 1 Then
         ReDim arrIn(1 To 1, 1 To 1): Let arrIn(1, 1) = Clm.FormulaR1C1
        Else
         Let arrIn() = Clm.FormulaR1C1
        End If
    Dim arrOut() As Variant
    Dim Rws() As Variant: Let Rws() = Evaluate("=ROW(1:" & lRow - sRow + 1 & ")/ROW(1:" & lRow - sRow + 1 & ")")
    Dim Clms() As Variant: Let Clms() = Evaluate("=COLUMN(A:" & CL(UBound(arrIn(), 2)) & ")")
     Let arrOut() = Application.Index(arrIn(), Rws(), Clms())
        With Clm.Offset(sRow - fRow).Resize(lRow - sRow + 1)
         .Value = arrOut()
         .Value = .Value
        End With
    Next Clm
 Let Application.ScreenUpdating = True
End Sub
Public Function CL(ByVal lclm As Long) As String
    Do: Let CL = Chr(65 + (((lclm - 1) Mod 26))) & CL: Let lclm = (lclm - (1)) \ 26: Loop While lclm > 0
End Function

It is up to all of you now.Thank you all for your help

[Doc.AElstein]

...second macro I tested it on the real data and it takes only 50 seconds Instead of two minutes......Sub ConvertingFormulasToValues2()....

I am a bit surprised by this. But I also am not too sure what to expect.
_.___________________
Important in doing any comparisons is to repeat measurements. Do many. Do them at different times. If you have the possibility, then check measurements again on other computers.
For accurate comparisons, your conclusions should be based on average measurements of many repeated measurements.
Many factors effect the final speed. You may not always get the same results for the same macros.

_._________

These two macros are only minor modifications to Sub ConvertingFormulasToValues2()
I would not expect much improvement, if any

Code: Select all

Sub ConvertingFormulasToValues2b()   '    https://eileenslounge.com/viewtopic.php?p=267991&sid=1a56795f7d91b6d42c3fe39a0712df66#p267991
Dim Ws As Worksheet, Rng As Range, Clm As Range, lRow As Long
Const fRow As Long = 6: Const sRow As Long = 8
 Set Ws = ThisWorkbook.Worksheets("data")
 On Error Resume Next
 Set Rng = Ws.Rows(fRow).SpecialCells(xlCellTypeFormulas)
 On Error GoTo 0
    If Rng Is Nothing Then MsgBox "No formulas!": Exit Sub
 Let lRow = Ws.Cells.Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
 Let Application.ScreenUpdating = False
    For Each Clm In Rng.Areas
    Dim arrIn() As Variant
        If Clm.Columns.Count = 1 Then
         ReDim arrIn(1 To 1, 1 To 1): Let arrIn(1, 1) = Clm.FormulaR1C1
        Else
         Let arrIn() = Clm.FormulaR1C1
        End If
    Dim arrOut() As Variant
'    Dim Rws() As Variant: Let Rws() = Evaluate("=ROW(1:" & lRow - sRow + 1 & ")/ROW(1:" & lRow - sRow + 1 & ")")
'    Dim Clms() As Variant: Let Clms() = Evaluate("=COLUMN(A:" & CL(UBound(arrIn(), 2)) & ")")
     Let arrOut() = Application.Index(arrIn(), Evaluate("=ROW(1:" & lRow - sRow + 1 & ")/ROW(1:" & lRow - sRow + 1 & ")"), Evaluate("=COLUMN(A:" & CL(UBound(arrIn(), 2)) & ")"))
'     Clm.Copy
        With Clm.Offset(sRow - fRow).Resize(lRow - sRow + 1)
'         .PasteSpecial Paste:=xlPasteFormulas
         .Value = arrOut()
         .Value = .Value
        End With
    Next Clm
 Let Application.ScreenUpdating = True
End Sub
Public Function CL(ByVal lclm As Long) As String '         http://www.excelforum.com/development-testing-forum/1101544-thread-post-appendix-no-reply-needed-please-do-not-delete-thanks-4.html#post4213980
    Do: Let CL = Chr(65 + (((lclm - 1) Mod 26))) & CL: Let lclm = (lclm - (1)) \ 26: Loop While lclm > 0
End Function
Sub ConvertingFormulasToValues2c()    '   https://eileenslounge.com/viewtopic.php?p=267991&sid=1a56795f7d91b6d42c3fe39a0712df66#p267991
Dim Ws As Worksheet, Rng As Range, Clm As Range, lRow As Long
Const fRow As Long = 6: Const sRow As Long = 8
 Set Ws = ThisWorkbook.Worksheets("data")
 On Error Resume Next
 Set Rng = Ws.Rows(fRow).SpecialCells(xlCellTypeFormulas)
 On Error GoTo 0
    If Rng Is Nothing Then MsgBox "No formulas!": Exit Sub
 Let lRow = Ws.Cells.Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
 Let Application.ScreenUpdating = False
    For Each Clm In Rng.Areas
    Dim arrIn() As Variant
        If Clm.Columns.Count = 1 Then
         ReDim arrIn(1 To 1, 1 To 1): Let arrIn(1, 1) = Clm.FormulaR1C1
        Else
         Let arrIn() = Clm.FormulaR1C1
        End If
    Dim arrOut() As Variant
'    Dim Rws() As Variant: Let Rws() = Evaluate("=ROW(1:" & lRow - sRow + 1 & ")/ROW(1:" & lRow - sRow + 1 & ")")
'    Dim Clms() As Variant: Let Clms() = Evaluate("=COLUMN(A:" & CL(UBound(arrIn(), 2)) & ")")
     Let arrOut() = Application.Index(arrIn(), Evaluate("=ROW(1:" & lRow - sRow + 1 & ")/ROW(1:" & lRow - sRow + 1 & ")"), Evaluate("=COLUMN(A:" & Split(Cells(1, UBound(arrIn(), 2)).Address, "$")(1) & ")"))
'     Clm.Copy
        With Clm.Offset(sRow - fRow).Resize(lRow - sRow + 1)
'         .PasteSpecial Paste:=xlPasteFormulas
         .Value = arrOut()
         .Value = .Value
        End With
    Next Clm
 Let Application.ScreenUpdating = True
End Sub

[Doc.AElstein]

This is my, Sub WriteFormulas() , full version, for all formulas in a row

Code: Select all

Sub WriteFormulasFull() ' Relative formulas   https://teylyn.com/2017/03/21/dollarsigns/#comment-191    https://eileenslounge.com/viewtopic.php?p=267991&sid=1a56795f7d91b6d42c3fe39a0712df66#p267991
Dim Ws As Worksheet, Rng As Range, Clm As Range, lRow As Long
Const fRow As Long = 6: Const sRow As Long = 8
 Set Ws = ThisWorkbook.Worksheets("data")
 Let lRow = Ws.Cells.Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
  On Error Resume Next
 Set Rng = Ws.Rows(fRow).SpecialCells(xlCellTypeFormulas)
 On Error GoTo 0
    If Rng Is Nothing Then MsgBox "No formulas!": Exit Sub

 Let Application.ScreenUpdating = False
    For Each Clm In Rng
     Let Clm.Offset(sRow - fRow).Resize(lRow - sRow + 1).Value = Clm.FormulaR1C1
     Let Clm.Offset(sRow - fRow).Resize(lRow - sRow + 1).Value = Clm.Offset(sRow - fRow).Resize(lRow - sRow + 1).Value
    Next Clm
 Let Application.ScreenUpdating = True

End Sub

Alan

[menajaro]

Welcome Mr. Alan
Thanks a lot for your guidance
Give me some time to work on the original file and I will test it deeper and check the results
To make accurate comparisons and I will tell you about any notes
Thank you very much for your great efforts. Have a nice time

[menajaro]

Welcome Mr. Alan
i am confused right now .... I followed your instructions
I checked measurements again On many other computers.but all codes take the same time, except for the last code ... Sub WriteFormulasFull()
where the implementation time it took about 30 seconds (There is a noticeable improvement)
but unfortunately it does not give correct results from the first time
( In other words, I must run the code twice in a row to get the correct results, this should not be )
Thanks again for your support, regards.

Code: Select all

Sub WriteFormulasFull()
Dim Ws As Worksheet, Rng As Range, Clm As Range, lRow As Long
Const fRow As Long = 6: Const sRow As Long = 8
 Set Ws = ThisWorkbook.Worksheets("data")
 Let lRow = Ws.Cells.Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
  On Error Resume Next
 Set Rng = Ws.Rows(fRow).SpecialCells(xlCellTypeFormulas)
 On Error GoTo 0
    If Rng Is Nothing Then MsgBox "No formulas!": Exit Sub

 Let Application.ScreenUpdating = False
    For Each Clm In Rng
    Let Clm.Offset(sRow - fRow).Resize(lRow - sRow + 1).Value = Clm.FormulaR1C1
    Let Clm.Offset(sRow - fRow).Resize(lRow - sRow + 1).Value = Clm.Offset(sRow - fRow).Resize(lRow - sRow + 1).Value
    Next Clm
 Let Application.ScreenUpdating = True

End Sub

[Doc.AElstein]

Hi,
It does not surprise me that you got different results. You should always repeat such measurements. You should never make conclusions too quickly when comparing performance of anything to do with a computer. Modern computers are so complicated with so many different things effecting things that, a small number of measurements will rarely give conclusive results.

I do not understand why you needed to run the macro twice. On your test data I did not experience that. I do not know what might cause such strange effects. Someone with more experience of such things may have an idea.

You could try a simple experiment of removing the Application.ScreenUpdating = False
In most cases, Application.ScreenUpdating = False improves speed. I have occasionally seen it cause strange effects. Personally I never use Application.ScreenUpdating = False. But that is just a personal preference:. I mostly try to use “VBA array” techniques, similar to those which I have shown you previously. In most cases, Application.ScreenUpdating = False then has little effect.

I can’t at the moment think of any major new suggestions. My brain is not in computer modus much just now. If I do think of anything else I will post again.

The slight modification below might have some minor effect. You can probably see what it is doing: The formulas must be done for each column. But we can change formulas to values for each rectangular area, whether it has one or more columns.

Alan

Code: Select all

Sub WriteFormulasFull2() ' http://www.eileenslounge.com/viewtopic.php?p=268215#p268215
Dim Ws As Worksheet, Rng As Range, Clm As Range, lRow As Long
Const fRow As Long = 6: Const sRow As Long = 8
 Set Ws = ThisWorkbook.Worksheets("data")
 Let lRow = Ws.Cells.Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
  On Error Resume Next
 Set Rng = Ws.Rows(fRow).SpecialCells(xlCellTypeFormulas)
 On Error GoTo 0
    If Rng Is Nothing Then MsgBox "No formulas!": Exit Sub

 Let Application.ScreenUpdating = False
    For Each Clm In Rng
    Let Clm.Offset(sRow - fRow).Resize(lRow - sRow + 1).Value = Clm.FormulaR1C1
'    Let Clm.Offset(sRow - fRow).Resize(lRow - sRow + 1).Value = Clm.Offset(sRow - fRow).Resize(lRow - sRow + 1).Value
    Next Clm
 
    For Each Clm In Rng.Areas
    'Let Clm.Offset(sRow - fRow).Resize(lRow - sRow + 1).Value = Clm.FormulaR1C1
    Let Clm.Offset(sRow - fRow).Resize(lRow - sRow + 1).Value = Clm.Offset(sRow - fRow).Resize(lRow - sRow + 1).Value
    Next Clm
 
 Let Application.ScreenUpdating = True
End Sub

[menajaro]

Welcome Mr. Alan
I really do appreciate you taking the time to help me.
About the previous modification, I tested it on original data, But it took a long time
Take your time and I welcome any other Ideas. And I trust you have the best solutions In such difficult cases .. I am not in hurry
Again, thanks so much

[menajaro]

I would appreciate this help if possible.

[Doc.AElstein]

Hi

.. I trust you have the best solutions In such difficult cases....

Excal VBA is a very large subject, and I only know a very, very small part of it. The very small, minute , part I know about, I have tried to understand as much as possible. So I am quite good at this very small part that I know. But I am a long way from being anything like an experienced professional. So it is unlikely that I will be anywhere close to the best.
But also , I think it is unlikely that you will find any better solutions, unless you try to achieve the same as what you are doing without formulas. But as Hans said, Formulas can work very well in Excel. So you may already have all the best possible. I am not sure
_.__________________________-

My latest offering will be very difficult for you to implement in your actual real formulas. This is because it is using Evaluate Range techniques, which are a bit of a black magic subject, and sometimes require adjustment based on trial and error since no one understand them fully
To complicate matters further, Microsoft have made a mess in changing things as usual since about 2013. So these Evaluate Range techniques work differently in different Office / Excel versions.

I have older Office / Excel versions.

I am returning you two workbooks.
Converting formulas to values.xlsm
and
Converting formulas to valuesB.xlsm
And I am giving you a new macro ( two versions of the same basic macro )

The macro does not work in my Excel on your test data in
Converting formulas to values.xlsm. It may work if you have a more recent version of Excel. I would welcome some feedback on that: Tell me if it works in your Excel or not on your test data. : ( In my Excel it returns the results of one row in all the rows)

The macro does work in my Excel for the modified test data in
Converting formulas to valuesB.xlsm
The modification is writing your test formulas slightly differently. I don’t know exactly why the modified formulas work for me when the originals don’t. As I said .."...Evaluate Range techniques, are a bit of a black magic subject ...."
Original:
=IF(OR(G6="eileenslounge";G6="eileenslounge1";G6="eileenslounge2");1000;"")
Modified:
=IF(G6="eileenslounge";1000;IF(G6="eileenslounge1";1000;IF(G6="eileenslounge2";1000;"")))
_._____
The macro solution below would most likely require modifications to apply it to your actual formulas. These modifications may not be simple
The main characteristic of this solution is that it uses the VBA Evaluate(“ “) method to evaluate the entire range of formulas, and the results are returned in an array which is pasted directly into the spreadsheet.
So, approximately, in simple terms, the pasting formulas and converting to values is done at the same time. It is anybodies guess if it is quicker or slower in your situation…
_.____

I will , or course , post again if I have any other ideas, but I think I am all out of ideas, so don’t count on it!

Alan

_.____

Full macro

Code: Select all

Sub EvaluateRangeFormulas() ' https://eileenslounge.com/viewtopic.php?p=268393&sid=e65bef89011f3c208d3d1ec9752c1bb2#p268393
Dim Ws As Worksheet, Rng As Range, Clm As Range, lRow As Long
Const fRow As Long = 6: Const sRow As Long = 8
 Set Ws = ThisWorkbook.Worksheets("data")
 Let lRow = Ws.Cells.Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
  On Error Resume Next
 Set Rng = Ws.Rows(fRow).SpecialCells(xlCellTypeFormulas)
 On Error GoTo 0
    If Rng Is Nothing Then MsgBox "No formulas!": Exit Sub

  Let Application.ScreenUpdating = False
    For Each Clm In Rng
    Dim strEval As String
     Let strEval = Clm.Formula: Debug.Print strEval                                                             '  =IF(OR(G6="eileenslounge",G6="eileenslounge1",G6="eileenslounge2"),1000,"")
     Let strEval = Replace(strEval, "G6", "G8:G" & lRow & "", 1, -1, vbBinaryCompare): Debug.Print strEval      '  =IF(OR(G8:G29="eileenslounge",G8:G29="eileenslounge1",G8:G29="eileenslounge2"),1000,"")
    Let Clm.Offset(sRow - fRow).Resize(lRow - sRow + 1).Value = Evaluate(strEval)
    Next Clm
 
 Let Application.ScreenUpdating = True
End Sub

Same macro in “Long horizontal scroll it to see” form

Code: Select all

Sub EvaluateRangeFormulasScrollIt() ' https://eileenslounge.com/viewtopic.php?p=268393&sid=e65bef89011f3c208d3d1ec9752c1bb2#p268393
Dim Ws As Worksheet, Rng As Range, Clm As Range, lRow As Long
Const fRow As Long = 6: Const sRow As Long = 8
 Set Ws = ThisWorkbook.Worksheets("data")
 Let lRow = Ws.Cells.Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
  On Error Resume Next
 Set Rng = Ws.Rows(fRow).SpecialCells(xlCellTypeFormulas)
 On Error GoTo 0
    If Rng Is Nothing Then MsgBox "No formulas!": Exit Sub

  Let Application.ScreenUpdating = False
    For Each Clm In Rng
    Let Clm.Offset(sRow - fRow).Resize(lRow - sRow + 1).Value = Evaluate(Replace(Clm.Formula, "G6", "G8:G" & lRow & ""))
    Next Clm
 
 Let Application.ScreenUpdating = True
End Sub

[menajaro]

Welcome Mr. Alan
Thank you very much for not forgetting my issue
In the original file, these columns contain all the conditions used from ( A:J & L:N & U:BS )
How to modify these two lines in both code
This line is in the code Sub EvaluateRangeFormulasScrollIt()

Code: Select all

Let Clm.Offset(sRow - fRow).Resize(lRow - sRow + 1).Value = Evaluate(Replace(Clm.Formula, "G6", "G8:G" & lRow & ""))

And the other in Sub EvaluateRangeFormulas()

Code: Select all

Let strEval = Replace(strEval, "G6", "G8:G" & lRow & "", 1, -1, vbBinaryCompare): Debug.Print strEval 

I will be honest with you about the speed required for both codes and I will tell you about any notes after making these modifications
i am optimistic about you ...Thank you for your patience with me.

[menajaro]

I would be very thankful to all of you for your help.

[HansV]

If I had ideas for further improvement, I would post them, but unfortunately I don't have them, for reasons I pointed out earlier.

[menajaro]

Thanks for your reply Mr. Hans
In fact all solutions offered are very awesome
I think the solutions provided by Mr Alan, Easy and fast solutions to replace the formulas with values and a big step towards the ultimate aim.
The problem now is that I have a blurry vision about modification these two lines Referred to above.
Thanks all for any help I get.