Excel macro that changes all populated cells to value instead of formula

Question

at the moment I have a large table with formulas in every single cell that helps me track weekly percentage change of a parameter. They way I update this every week is I manually "Copy" & "Paste Value" on the last populated cell.

I am looking for a routine or script that can automatically go through every row, take the last populated cell and input the value as a "Value" instead of the underlying formula giving the value.

As the table is now growing with more and more parameters I would like to automate the manual process.

Any suggestions ?

Answer 1

This is how you can copy a cell or range of cells and paste in-place, retaining the values and number formats.

    '~~~> Copy/Paste (keeping the values and formats)
    rCell.Copy
    rCell.PasteSpecial (xlPasteValuesAndNumberFormats)

    '~~~> Clear marching ants
    Application.CutCopyMode = False

This is how to find the column number of the last non-blank cell in a row (different from finding the last empty cell).

    lCol = .Find("*", , xlValues, , xlByColumns, xlPrevious).Column

Looping only the rows in the used range will save time with larger data sets.

With rUsedRng

    '~~~> Loop each row in the used range
    For Each rRow In .Rows

        '~~~> Do something here.
        MsgBox "Ready for action on this row"

    Next

End With

This is how you can put it all together.

Sub FormulasToValues_LastCellInRow()

'~~~> Optimize speed
With Application

    .ScreenUpdating = False
    .DisplayAlerts = False

End With

'~~~> Declare the variables
Dim ws As Worksheet
Dim rUsedRng As Range
Dim rRow As Range
Dim rCell As Range
Dim lCol As Long

'~~~> Set the variables
Set ws = ActiveSheet
Set rUsedRng = ws.UsedRange
'Debug.Print "rUsedRng = " & rUsedRng.Address

With rUsedRng

    '~~~> Loop each row in the used range
    For Each rRow In .Rows

        '~~~> Find the last non-blank cell (not the last empty cell)
        lCol = .Find("*", , xlValues, , xlByColumns, xlPrevious).Column

        '~~~> Set the range to be copied.
        Set rCell = ws.Cells(rRow.Row, lCol)
        'Debug.Print "rCell = " & rCell.Address

        '~~~> Copy/Paste (keeping the values and formats)
        rCell.Copy
        rCell.PasteSpecial (xlPasteValuesAndNumberFormats)

        '~~~> Clear marching ants
        Application.CutCopyMode = False

    Next

End With

'~~~> Release Variables from Memory
Set ws = Nothing
Set rUsedRange = Nothing
Set rCell = Nothing
lCol = vbNull

'~~~> Reset application items
With Application

    .ScreenUpdating = True
    .DisplayAlerts = True

End With

End Sub

Before Data

After Data