1

I'm trying to write a macro that would identify the last timestamp within a column, add a defined number of days and update a due date for every column in my data set, until it reaches a blank column.

This is a screenshot of the data set where I want the calc to run:

img1

For other calculations, I'm using the ActiveCell.Offset to navigate my spreadsheet and run the calculations, but using it for this case is getting very confusing.

Sample of code for existing calculations:

ws.Range("B74").Select
Do Until ActiveCell.Offset(0, 1).Value = ""
ActiveCell.Offset(-23, 1).Formula = "=Round(((R[-2]C[0]+R[-4]C[0])/R[-14]C[0])*100,2)"
    If IsError(ActiveCell.Offset(-23, 1)) Then ActiveCell.Offset(-23, 1).Value = "0"
ActiveCell.Offset(0, 1).Select
Loop
dwirony
  • 5,487
  • 3
  • 21
  • 43
Arjun
  • 9
  • 2
  • 1
    In general, you want to [avoid using `Select` and `ActiveCell`](https://stackoverflow.com/questions/10714251/how-to-avoid-using-select-in-excel-vba#10717999). Among the benefits are having an easier time going through the cells in your sheet. – cybernetic.nomad May 01 '18 at 19:26
  • Welcome! It's always better to embed an image instead of providing a link. – nbloqs May 01 '18 at 19:31

1 Answers1

0

In your case I would define an user-defined function (place the macro in a standard module) and then use that function inside the sheet as formula. The function returns the value of the last non empty cell and you then can perform your calculation directly in the sheet. Value2 is used to get the underlying value of the cell without taking formats into account.

Looks like you're interested in the navigation part (title of question). I show you three ways to get the last (I hope I understood your definition of last correctly) non empty cell in a range with a width of 1 column:

  • Looping through range (getLastValueWithLoop)
  • Using .End(xlUp) (getLastValueWithEnd)
  • Writing range values to array and then loop the array (fastest) (getLastValueWithArrayLoop)

I also included a function (updateDueDateInEachColumn) that goes through each column and updates the due date programmatically to not have to use the user-defined function.

Btw: You could prolly ditch using macros and just use a normal formula (see screenshot).

Code:

' **
' Get the value of the last non empty cell in rng
' @param {Range} rng Range to look in, 1 column only
' @return {Variant} Returns the value of the last non empty cell
' or false if all cells are empty
' Example:
' Use following function inside a sheet:
' =getLastValueWithLoop(A2:A6)
Public Function getLastValueWithLoop(rng As Range) As Variant
    Dim i As Long
    
    ' Loop through range and check if cell is not empty
    ' Starts at the bottom and moves 1 cell up each time
    For i = rng.Cells.Count To 1 Step -1
        If rng(i).Value2 <> "" Then
            getLastValueWithLoop = rng(i).Value
            Exit Function
        End If
    Next
    
    ' if no value in range set to false
    getLastValueWithLoop = False
End Function

' **
' Get the value of the last non empty cell in rng
' @param {Range} rng Range to look in, 1 column only
' @return {Variant} Returns the value of the last non empty cell
' or false if all cells are empty
' Example:
' Use following function inside a sheet:
' =getLastValueWithEnd(A2:A6)
Public Function getLastValueWithEnd(rng As Range) As Variant
    Dim i As Long
    Dim lastCell As Range
    Dim lastNonEmptyCell As Range
    
    ' Set last cell in range
    Set lastCell = rng(rng.Cells.Count)
    
    ' Use .end(xlup) to get first non empty
    ' This is the same as using the keys CTRL + Up
    If lastCell <> "" Then
        ' Needs to check if last cell is empty first as else
        ' end(xlup) would move up even if the cell is non empty
        ' Set as last non empty cell if not empty
        getLastValueWithEnd = lastCell.Value2
        Exit Function
    Else
        ' Use end(xlup) to get the first non empty cell moving up from
        ' the last cell. Check if the cell found with end(xlup) is inside the range
        ' with .Intersect as end(xlup) can move outside the range provided
        ' If it is inside the range set last non empty cell
        If Not Application.Intersect(rng, lastCell.End(xlUp)) Is Nothing Then
            getLastValueWithEnd = lastCell.End(xlUp).Value2
            Exit Function
        End If
    End If
    
    ' if no value in range set to false
    getLastValueWithEnd = False
End Function

' **
' Get the value of the last non empty cell in rng
' @param {Range} rng Range to look in, 1 column only
' @return {Variant} Returns the value of the last non empty cell
' or false if all cells are empty
' Example:
' Use following function inside a sheet:
' =getLastValueWithArrayLoop(A2:A6)
Public Function getLastValueWithArrayLoop(rng As Range) As Variant
    Dim rngAsArray As Variant
    Dim i As Long
    
    ' Write the rng values into an array
    ' This produces a two dimensional array
    rngAsArray = rng.Value2
    
    ' Loop through the array, move from bottom up and
    ' return first non empty cell
    For i = UBound(rngAsArray, 1) To LBound(rngAsArray, 1) Step -1
        If rngAsArray(i, 1) <> "" Then
            getLastValueWithArrayLoop = rngAsArray(i, 1)
            Exit Function
        End If
    Next
    
    ' if no value in range set to false
    getLastValueWithArrayLoop = False
End Function

' **
' Check rngColumn for last value (exit if none found) and
' update rngDueDate then move one column to the right etc.
' This macro relies on the function getLastValueWithLoop.
' @param {Range} rngColumn First column range to get last value in
' @param {Range} rngDueDate First cell to update due date in
' Example call in macro:
' updateDueDateInEachColumn Range("B2:B6"), Range("B7")
Public Sub updateDueDateInEachColumn(rngColumn As Range, rngDueDate As Range)
    Dim rng As Range
    Dim lastValue As Variant
    
    ' Loop until column is empty
    Do
        ' Get last value of column range, returns false if no value found
        lastValue = getLastValueWithLoop(rngColumn)
        If lastValue = False Then
            ' Exit the loop if no value was found
            Exit Do
        Else
            ' Update due date
            rngDueDate = lastValue + 10 ' TODO: add your calculation here
        End If
        ' Offset column and due date range by one column
        Set rngColumn = rngColumn.Offset(, 1)
        Set rngDueDate = rngDueDate.Offset(, 1)
    Loop
    
End Sub

Example usage of the functions inside a sheet:

example usage

shaedrich
  • 5,457
  • 3
  • 26
  • 42
Hubisan
  • 1,102
  • 10
  • 18