Still celebrating National IT Professionals Day with 3 months of free Premium Membership. Use Code ITDAY17

x
?
Solved

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

Posted on 2014-11-25
5
Medium Priority
?
191 Views
Last Modified: 2014-11-26
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
0
Comment
Question by:ekaplan323
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 3
5 Comments
 
LVL 23

Expert Comment

by:Michael Fowler
ID: 40465842
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
 
LVL 23

Expert Comment

by:Michael Fowler
ID: 40465881
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
 
LVL 23

Expert Comment

by:Michael Fowler
ID: 40465892
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
 
LVL 18

Accepted Solution

by:
krishnakrkc earned 2000 total points
ID: 40466048
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
 

Author Closing Comment

by:ekaplan323
ID: 40467670
very concise code and did the trick.  The other answer was also very good.  Thanks
0

Featured Post

Independent Software Vendors: We Want Your Opinion

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

A little background as to how I came to I design this code: Around 5 years ago I designed an add-in that formatted Excel files to a corporate standard, applying different cell colours and font type depending on whether the cells contained inputs,…
This code takes an Excel list of URL’s and adds a header titled “URL List”. It then searches through all URL’s in column “A”, looking for duplicates. When a duplicate is found, it is moved to the top of the list. The duplicate URL’s are then highlig…
This Micro Tutorial demonstrates how to create Excel charts: column, area, line, bar, and scatter charts. Formatting tips are provided as well.
This Micro Tutorial will demonstrate on a Mac how to change the sort order for chart legend values and decrpyt the intimidating chart menu.

688 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question