Excel VBA to copy the first formula found to all of the rows in that column

I am trying to create a macro that will find the column that has "Total Fee" as the column heading in row 5.  Go down the column to the first formula (other rows are blank) and copy that formula up and down the other cells on that column (can overwrite all data) to the last cell in that column (there are blank cells).

After that turn all formulas in that column to values.

Thanks, Eric
ekaplan323Asked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

Michael FowlerSolutions ConsultantCommented:
A couple of questions

Is it possible that the column can have an empty cells at the bottom, if so which column could be used to determine the last cell.

Could you post an example file with dummy data so we can test any script developed
0
Michael FowlerSolutions ConsultantCommented:
Another question

Should the formula remain "as is" during the copy or do you need the appropriate values to move with the formula ie the equivalent of dragging the formula up or down
0
Michael FowlerSolutions ConsultantCommented:
To get started here is a macro that assumes that the column with the formula has a value in the last row

The code to copy the formula contains both an increment and exact copy sections. Just remove the single quotes from the start of the section you want (Only the ones at the start of the line)

Sub macro1()
    
    Const START_ROW As Integer = 6
    Const HEADER_ROW As Integer = 5
    Const HEADER_NAME As String = "Total Fee"
    
    Dim i As Integer, lastRow As Integer, col As Integer, fRow As Integer
    Dim fmla As String
    
    ' Get column number
    i = 1
    While (col = 0)
        If (Cells(HEADER_ROW, i).Value = HEADER_NAME) Then
            col = i
        Else
            i = i + 1
        End If
    Wend
    
    ' Set last row
    lastRow = Cells(Rows.Count, col).End(xlUp).Row
        
    'Get Formula
    i = START_ROW
    While (i <= lastRow And fmla = "")
        If (Cells(i, col).HasFormula) Then
            fmla = Cells(i, col).formula
            fRow = i
        End If
        i = i + 1
    Wend
    If (fmla = "") Then
        MsgBox "No formula found"
        Exit Sub
    End If

'    ' Copy formula into column (exact)
'    For i = START_ROW To lastRow
'        Cells(i, col).formula = fmla
'    Next i
'
    ' Copy formula into column (increment)
'    Cells(fRow, col).AutoFill Destination:=Range(Cells(START_ROW, col), Cells(fRow, col)), Type:=xlFillDefault
'    Cells(fRow, col).AutoFill Destination:=Range(Cells(fRow, col), Cells(lastRow, col)), Type:=xlFillDefault

    ' Remove formulas
    Range(Cells(START_ROW, col), Cells(lastRow, col)).Copy
    Range(Cells(START_ROW, col), Cells(lastRow, col)).PasteSpecial Paste:=xlPasteValues
    Application.CutCopyMode = False
    
End Sub

Open in new window

0
krishnakrkcCommented:
Sub kTest()
    
    Dim r   As Range, f As Range, i As Long
    
    Set r = Rows(5).Find("Total Fee", lookat:=1)
    If Not r Is Nothing Then
        i = Cells(Rows.Count, r.Column).End(3).Row
        On Error Resume Next
        Set f = r.Resize(i).SpecialCells(xlCellTypeFormulas).Cells(1)
        On Error GoTo 0
        If Not f Is Nothing Then
            f.Copy r.Offset(1).Resize(i - r.Row)
            r.Offset(1).Resize(i - r.Row).Value2 = r.Offset(1).Resize(i - r.Row).Value
        End If
    End If
    
End Sub

Open in new window


Kris
0

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
ekaplan323Author Commented:
very concise code and did the trick.  The other answer was also very good.  Thanks
0
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Microsoft Excel

From novice to tech pro — start learning today.

Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.