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("I temList"))
'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(dataStartR ow, 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(sh eetName)
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
Here is the current code:
Option Explicit
Sub ShilohScripts()
'Call CopyDataFormulas(Sheets("I
'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
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(dataStartR
If VBA.Left(dataCell.Formula,
With dataSheet
Set destRange = .Range(.Cells(dataStartRow
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(sh
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
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
ASKER