Link to home
Start Free TrialLog in
Avatar of ScottBarnes
ScottBarnes

asked on

Excel VBA to copy all formula's down to the last row of data

There is some vba code in a spreadsheet I inherited that copies all formula's down to the last row of data since the number of rows can value depends on who is using the report.  The code works great as a long as you have a header row and the data starts on row 2.  I would like to use the code on a excel tab that does not start on row two, my new sheet has a header row on row 3 and the data starts on row 4.  However, would it be possible to get help changing the code to where it doesn't matter what row the data starts on.

Here is the current code:

Option Explicit

Sub ShilohScripts()
'Call CopyDataFormulas(Sheets("ItemList"))

'Searches for and copies the custom formulas added to each row of the data sheet for the number
'of rows of data. Literals can work to, they just need to be a formula form (=1, ="A", etc.)
Private Sub CopyDataFormulas(dataSheet As Excel.Worksheet, Optional dataStartRow As Integer = 2)
Dim c As Integer
Dim dataCell As Range
Dim numRows As Long
Dim destRange As Excel.Range

    numRows = GetLastRow(dataSheet)
    If (numRows - dataStartRow) = 0 Then Exit Sub 'Only one data row, no need to copy.
   
    For c = 1 To GetLastCol(dataSheet)
        Set dataCell = dataSheet.Cells(dataStartRow, c)
        If VBA.Left(dataCell.Formula, 1) = "=" Then
            With dataSheet
                Set destRange = .Range(.Cells(dataStartRow + 1, c), .Cells(numRows, c))
            End With
            dataCell.Copy destRange
        End If
    Next c
End Sub

'A more reliable way to get the last row on a data sheet then UsedRange.
Private Function GetLastRow(ws As Worksheet) As Long
    On Error GoTo GetLastRowError

    Dim rLastCell As Object
    Set rLastCell = ws.Cells.Find("*", ws.Cells(1, 1), , , xlByRows, xlPrevious)
    GetLastRow = rLastCell.Row
    Exit Function
   
GetLastRowError:
    MsgBox "Error on GetLastRow function. Error: " & Err.Number & " - " & Err.Description, vbCritical, "Severe Error"
End Function

'A more reliable way to get the last column on a data sheet then UsedRange.
Private Function GetLastCol(ws As Worksheet) As Long
    On Error GoTo GetLastColError
   
    Dim rLastCell As Object
    Set rLastCell = ws.Cells.Find("*", ws.Cells(1, 1), , , xlByColumns, xlPrevious)
    GetLastCol = rLastCell.Column
    Exit Function
   
GetLastColError:
    MsgBox "Error on GetLastCol function. Error: " & Err.Number & " - " & Err.Description, vbCritical, "Severe Error"
End Function

'Gets a value on a worksheet where the value name is defined in column A and the value is in column B.
Private Function GetNameValue(sheetName As String, valueName As String) As String
Dim xlSheet As Worksheet
Dim theARange As Range
Dim findRange As Range

    On Error GoTo GetNameValueError

    Set xlSheet = ThisWorkbook.Worksheets(sheetName)
   
    With xlSheet
        Set theARange = .Range("A:A")
        Set findRange = theARange.Find(valueName)
        If findRange Is Nothing Then
            GetNameValue = ""
        Else
            GetNameValue = findRange.Offset(0, 1).Value
        End If
    End With
   
    Exit Function
   
GetNameValueError:
    MsgBox "Error on GetNameValue function. Error: " & Err.Number & " - " & Err.Description, vbCritical, "Severe Error"
End Function
ASKER CERTIFIED SOLUTION
Avatar of Rgonzo1971
Rgonzo1971

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
Avatar of ScottBarnes
ScottBarnes

ASKER

I'm glad it is such an easy fix.  Thank you so much.