CODEWITHSUNDEEP
excelvbaspreadsheet
Dumb Blonde
Dumb Blonde

Reputation: 15

Copy formula from another worksheet based on cell reference for a single row

This is very similar to my previous post, but instead of copying formulas to all of the rows, I need to just copy the formulas to a single row. 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: I have a button that inserts a new row above the selected row and then pastes the formulas from worksheet 'Data' into the new row. The problem is that inserting the new row breaks the cell references of the formulas in the row below.

So I need to update the formulas, but cannot do a simple cut and paste for the entire row, because I don't want to overwrite any cells where the formulas have been replaced 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 'Add Row' button,
  2. Insert a new row on worksheet 'Guide Outputs' and copy formulas from worksheet 'Data' (This part works fine),
  3. On worksheet 'Guide Outputs', in the row below the inserted row, find all cells with formulas,
  4. Lookup the columns on worksheet 'Data',
  5. Copy formula from worksheet 'Data' cell(col=reference,row=3),
  6. Paste into the cells that contain formulas for the row on worksheet 'Guide Outputs' (each column has a different formula),
  7. Repeat for each cell.
  8. End result should be that all cells with formulas get updated with the correct formula and the cells with plain text are ignored.

This should only update the single row below the inserted row in order to 'fix' the broken formulas.

The formulas on the 'Data' worksheet are in cells B3:AE3.

Example:

Worksheet 'Guide Outputs' H11, L11, M11, R11 have formula, so copy/paste formulas from worksheet 'Data' H3, L3, M3, R3.

Worksheet 'Guide Outputs' B20, C20, L20, M20 have formula, so copy/paste updated formula from worksheet 'Data' B3, C3, L3, M3.

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!

This is very similar to my previous post, but instead of copying formulas to all of the rows, I need to just copy the formulas to a single row. Copy formula from another worksheet based on cell reference

Here's the part that works, ie inserting the new row, copying the formulas and making the text blue.

I need something that now fixes the broken formulas in the row below.

    Sub AddRow_Click()
    '
    ' AddRow Macro
    '
        Selection.EntireRow.Insert
        Sheets("Data").Range("B3:AE3").Copy
        Sheets("Guide Outputs").Select
    
        With ActiveCell
            Range("B" & .Row & ":AE" & .Row).Select
            Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
                SkipBlanks:=False, Transpose:=False
        End With
    
        Application.CutCopyMode = False
    
        With Selection.Font
            .ThemeColor = xlThemeColorAccent1
            .TintAndShade = 0
        End With

    End Sub

Upvotes: 0

Views: 254

Answers (2)

karma
karma

Reputation: 2009

Sub test()
Dim rg As Range, cell As Range

Selection.EntireRow.Insert
On Error Resume Next
Set rg = ActiveCell.Offset(1, 0).EntireRow.SpecialCells(xlCellTypeFormulas)
If Err.Number <> 0 Then ActiveCell.EntireRow.Delete: Exit Sub

For Each cell In rg
Sheets("DATA").Range(Replace(cell.Address, "$" & rg.Row, "$" & 3)).Copy Destination:=cell
Next

End Sub

Set rg as the range of all cells which has formula in the row below the inserted row. If it can't create the rg, use the error trap, delete the inserted row and then exit the sub.

Then loop to each cell (which has formula) in rg, then get the formula in sheet DATA by replacing the looped cell address row number to 3, copy the formula into the looped cell.

That's if I understand you correctly.

Upvotes: 0

HannahW
HannahW

Reputation: 98

Using the code from the previous answer, I have amended it slightly. I think it now works with your data set.

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

Set drg = Range("B" & ActiveCell.Row & ":AE" & ActiveCell.Row)


Dim sws As Worksheet: Set sws = wb.Sheets(SRC_SHEET)
Dim srg As Range:
Set srg = sws.Range(SRC_FIRST_CELL).Resize(1, drg.Columns.Count)


'Application.ScreenUpdating = False

Dim dvrg As Object, dcrg As Object, c As Long

For Each dcrg In drg
dcrg.Activate
    c = c + 1
    On Error Resume Next
        Set dvrg = dcrg.SpecialCells(xlCellTypeFormulas).Cells(1, 1)
     
    On Error GoTo 0
    If Not dvrg Is Nothing Then

    
        dcrg = srg.Cells(1, c + 1).FormulaR1C1
      
        Set dvrg = Nothing
    'Else ' no formula in column; do nothing
    End If
Next dcrg

Application.ScreenUpdating = False

MsgBox "Formulas updated.", vbInformation

End Sub

Adding the link to the original post so it doesn't appear plagiarized: Copy formula from another worksheet based on cell reference

Upvotes: 0

Related Questions