CODEWITHSUNDEEP
excelvbaspreadsheet
Dumb Blonde
Dumb Blonde

Reputation: 15

Copy formula from another worksheet based on cell reference

Background: I have a worksheet 'Guide Outputs' with columns A:AE. Each column has it's own formula, however, not every cell in the column has a formula (Sometimes I need to overwrite it with plain text).

Problem: Sometimes I need to update the formulas, but cannot do a simple cut and paste for the entire column, because I don't want to overwrite the cells with plain text.

What I need: Macro that copies the updated formula from worksheet 'Data' based on the column reference of the cell on worksheet 'Guide Outputs':

  1. When I click 'Update' button,
  2. On worksheet 'Guide Outputs' find all cells in column with formula,
  3. Lookup that column on worksheet 'Data',
  4. Copy formula from worksheet 'Data' cell(col=reference,row=3),
  5. Paste into all cells with formulas in selected column on worksheet 'Guide Outputs',
  6. Repeat for each column.

End result should be that all cells with formulas get updated with the correct formula and the cells with plain text are ignored.

This could be done one cell at a time, but doing entire column at a time should be faster because there are hundreds of rows.

Example:

I am pretty advanced with formulas, but a newb at VBA. I can record macros and mash stuff together that I find online but that's about it!

Sorry but I could not even find anything to get started with.

Upvotes: 0

Views: 138

Answers (1)

VBasic2008
VBasic2008

Reputation: 54807

Update Formulas Only in Cells Containing Formulas

Option Explicit

Sub UdateFormulas()

    Const SRC_SHEET As String = "Data"
    Const SRC_FIRST_CELL As String = "A3"
    
    Const DST_SHEET As String = "Guide Outputs"
    Const DST_FIRST_CELL As String = "A3"
    
    Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
    
    Dim dws As Worksheet: Set dws = wb.Sheets(DST_SHEET)
    Dim drg As Range
    With dws.UsedRange
        Set drg = dws.Range(DST_FIRST_CELL, .Cells(.Cells.CountLarge))
    End With
    
    Dim sws As Worksheet: Set sws = wb.Sheets(SRC_SHEET)
    Dim srg As Range:
    Set srg = sws.Range(SRC_FIRST_CELL).Resize(, drg.Columns.Count)

    Application.ScreenUpdating = False
    
    Dim dvrg As Range, dcrg As Range, c As Long
    
    For Each dcrg In drg.Columns
        c = c + 1
        On Error Resume Next
            Set dvrg = dcrg.SpecialCells(xlCellTypeFormulas)
        On Error GoTo 0
        If Not dvrg Is Nothing Then
            srg.Cells(c).Copy dvrg
            Set dvrg = Nothing
        'Else ' no formula in column; do nothing
        End If
    Next dcrg
 
    Application.ScreenUpdating = False
    
    MsgBox "Formulas updated.", vbInformation

End Sub

Upvotes: 2

Related Questions