Formula Copy/Fill-Down Until Last Row

[menajaro]

Hello everyone
This macro will convert formulas to its values until last row

Code: Select all

Sub ConvertFormulasToValues()
    Dim ws As Worksheet, rng As Range, cl As Range, lr As Long, c As Long
    Const fRow As Long = 6
    Const sRow As Long = 8
    
    With Application
        .Calculation = xlCalculationManual
        .ScreenUpdating = False
        .EnableEvents = False
        .DisplayAlerts = False
        .Cursor = xlWait
        .EnableCancelKey = xlErrorHandler
        End With

        Set ws = ThisWorkbook.Worksheets("DATA")
        lr = ws.Cells.Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
        
        Set rng = ws.Rows(fRow).SpecialCells(xlCellTypeFormulas)
        
        For Each cl In rng
            c = cl.Column
            ws.Cells(fRow, c).Copy: ws.Cells(sRow, c).PasteSpecial Paste:=xlPasteFormulas
            
            With ws.Range(ws.Cells(sRow, c), ws.Cells(lr, c))
                .Formula = ws.Cells(sRow, c).Formula
            .Value = .Value
            End With
        Next cl
    
         With Application
        .CutCopyMode = False
        .Calculation = xlCalculationAutomatic
        .ScreenUpdating = True
        .EnableEvents = True
        .DisplayAlerts = True
        .Cursor = xlDefault
        .StatusBar = False
        .EnableCancelKey = xlInterrupt

End With
End Sub

this macro runs over 1 minute. I had added some code to make it faster , but not improving much.
so I am searching for alternative approach using arrays for example or any other way avoiding loops
Note : I'm now working on a file with 20000 rows
any help on this is much Appreciated! Thank you in advance for looking at this.

[HansV]

Can't you simply use

Code: Select all

    With Worksheets("Data").UsedRange
        .Value = .Value
    End With

[menajaro]

Welcome Mr. Hans ... I am sorry that I could not understand you properly

[HansV]

Change the macro to

Code: Select all

Sub ConvertFormulasToValues()
    With Worksheets("Data").UsedRange
        .Value = .Value
    End With
End Sub

[menajaro]

Thanks for your reply Mr. Hans
I do not think you are mocking me, is not it?
thanks a lot

[HansV]

No, I'm not mocking you at all! If the macro that I proposed does not do what you want, please explain in detail what you want to accomplish.

[menajaro]

Thanks a lot Mr. Hans
In fact there is no problem with the code and it is working well .. But with some more data it took so much time
I will try to explain what I am attempting to achieve.
Row No 6 in the original file contains many formulas
These formulas will be converted to its values from row No 8 until last row of data

Code: Select all

Sub Test()
    Dim ws As Worksheet, rng As Range, cl As Range, lr As Long, c As Long
    Const fRow As Long = 6
    Const sRow As Long = 8
    
    Application.ScreenUpdating = False
        Set ws = ThisWorkbook.Worksheets("data")
        lr = ws.Cells.Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
        Set rng = ws.Rows(fRow).SpecialCells(xlCellTypeFormulas)
        
        For Each cl In rng
            c = cl.Column
            ws.Cells(fRow, c).Copy: ws.Cells(sRow, c).PasteSpecial Paste:=xlPasteFormulas
            
            With ws.Range(ws.Cells(sRow, c), ws.Cells(lr, c))
                .Formula = ws.Cells(sRow, c).Formula
                .Value = .Value
            End With
        Next cl
        Application.CutCopyMode = False
    Application.ScreenUpdating = True
End Sub

My requirement is that if there an alternative approach using arrays for example or any other way avoiding loops to make the code faster than that
I would be very thankful to all of you for your help.

[HansV]

Is this better?

Code: Select all

Sub Test()
    Dim ws As Worksheet, rng As Range, cl As Range, lRow As Long
    Const fRow As Long = 6
    Const sRow As Long = 8
   
    Application.ScreenUpdating = False
    Set ws = ThisWorkbook.Worksheets("data")
    lRow = ws.Cells.Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row

    Set rng = ws.Rows(fRow).SpecialCells(xlCellTypeFormulas)
    For Each cl In rng.Areas
        cl.Copy
        With cl.Offset(sRow - fRow).Resize(lRow - sRow + 1)
            .PasteSpecial Paste:=xlPasteFormulas
            .Value = .Value
        End With
    Next cl
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
End Sub

[menajaro]

Thanks a lot Mr. Hans
now I get Run-time error 1004 in this line

Code: Select all

Set rng = ws.Rows(fRow).SpecialCells(xlCellTypeFormulas)

So how I can fix that? Thanks again.

[HansV]

That error would occur if row 6 doesn't contain any formulas. The following version handles that:

Code: Select all

Sub Test()
    Dim ws As Worksheet, rng As Range, cl 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
    End If

    lRow = ws.Cells.Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    Application.ScreenUpdating = False
    For Each cl In rng.Areas
        cl.Copy
        With cl.Offset(sRow - fRow).Resize(lRow - sRow + 1)
            .PasteSpecial Paste:=xlPasteFormulas
            .Value = .Value
        End With
    Next cl
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
End Sub

[menajaro]

Thank you so much Mr. Hans for your time and patience. Really appreciate that.
There is no improvement in the speed of the code, I welcome any other solutions.
And I am sure you have the best solutions all the time.I hope so my tutor

[HansV]

I'm afraid I have no further ideas.

[menajaro]

I am not afraid of that ... You are a trustworthy person

[menajaro]

I would appreciate this help if possible.

[Doc.AElstein]

Hello menajaro
I can’t help because I cannot understand easily what you are wanting to do.
I am unable to understand what you want. I am unable to understand the explanations that you have given so far in this Thread.
That may be because I am stupid, but unless you can explain clearly enough for me to understand, then I can't help.

If you can upload a workbook with reduced data – just a few rows, and in that explain clearly what you want, … then if you can do that then I will take a look later… maybe tomorrow, if you don’t get it solved in the meantime..

The purpose of the workbook will be to explain clearly what you want to do. Nothing else. So only use a small amount of data, but choose the test data carefully so that it demonstrates all scenarios
Show what you have Before , and then show , possibly in a second worksheet , what you should have After the macro is run. ( Fill the second worksheet in manually to show exactly what the macro should do)

Alan

[menajaro]

Hello Mr. Alan
Thank you very much for your interest in the issue
for illustration
The 6 row in this Attached sample contains many formulas According to different conditions.
These formulas will be converted to its values Beginning from row 8 until last row of data.
As I mentioned above, the code works great but the code takes about 2 minutes to run With large amounts of data (about 20000 row + 150 Column and probably more ).
So I'm looking for another way to improve code speed Or maybe use an alternative approach to achieve this.
Attached sample may clarify more ... Thank you in advance for your help.

[HansV]

20000 rows x 150 columns = 3 million formulas. If your real formulas are complicated, it'll take time to calculate 3 million of them!

This is slightly faster, but not much:

Code: Select all

Sub ConvertingFormulasToValues()
    Dim ws As Worksheet, rng As Range, cl 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
    End If

    lRow = ws.Cells.Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    Application.ScreenUpdating = False
    For Each cl In rng.Areas
        cl.Copy
        cl.Offset(sRow - fRow + 1).PasteSpecial Paste:=xlPasteFormulas
        With cl.Offset(sRow - fRow).Resize(lRow - sRow + 1)
            .FillDown
            .Value = .Value
        End With
    Next cl
    Application.ScreenUpdating = True
End Sub

[Nick Vittum]

Isn't it true that all these calculations could be done directly in code, instead of utilizing formulas on the worksheet and bouncing back and forth from formula to code to worksheet? Would that speed things up a lot?

[HansV]

That depends on the actual formulas. Excel is very efficient at calculating formulas.

[Nick Vittum]

I see