Use latest sheet in formula vba

Viewed 58

I am using an excel sheet that should reference to the latest sheet in a series Inlife (n), I got the VBA so that it replaces the reference if I manually tell it which sheet to use. I cannot simply use the last sheet or the 5th of all sheets or something. However the position is always the sheet before sheet RG. I tried to use the same code as for copy and paste: =before... but this didn't get me anywhere, neither did count like below.


   Dim result As Integer 
   result = Count(If ws.Name = "Inlife" Or ws.Name Like "Inlife (*)")

ActiveSheet.Select

        Dim rng As Range, cel As Range
    Set rng = ActiveSheet.Range("B3:B25")
    

    For Each cel In rng
    cel.Formula = Replace(cel.Formula, "Inlife", "'Inlife (result)'")

    Next

This doesn't work at all but I hope you understand my intention. (I am sure this looks ridiculous but I do not know how else to describe my problem)

I hope you can help me

3 Answers

You can loop over the worksheets in order, assigning the latest worksheet to a variable if its name begins with "Inlife". When the loop completes, the variable will be set to the last sheet whose name begins with "Inlife".

Sub getinlife()

    Dim last_inlife_sheet As Worksheet
    
    For Each ws In ThisWorkbook.Worksheets
        ' Check if worksheet name begins with "Inlife"
        If InStr(1, ws.Name, "Inlife") = 1 Then
            Set last_inlife_sheet = ws
        End If
    Next ws
    
    (your code)
    
End Sub

I tested this using a workbook I mocked up with the following sheet names:

enter image description here

and verified that after running the loop, last_inlife_sheet was set to the sheet named Inlife (3).

Please try the next way:

Dim ws As Worksheet
Set ws = Worksheets("RG").Previous
For Each cel In rng
  cel.Formula = Replace(cel.Formula, "Inlife", "'" & ws.name & "'")
Next

Update Formula Worksheet References

Option Explicit

Sub UpdateFormulaWorksheetReferences()
    On Error GoTo ClearError
    Const ProcName As String = "UpdateFormulaWorksheetReferences"
    
    Const dfCellAddress As String = "B3"
    Const ashName As String = "RG"
    Const swsBaseName As String = "Inlife"
    
    ' Create a reference to the Destination worksheet.
    Dim dws As Worksheet: Set dws = ActiveSheet
    
    ' Check if there is any data in the destination column.
    Dim dfCell As Range: Set dfCell = dws.Range(dfCellAddress)
    Dim dlCell As Range
    Set dlCell = dfCell.Resize(dws.Rows.Count - dfCell.Row + 1) _
        .Find("*", , xlFormulas, , , xlPrevious)
    If dlCell Is Nothing Then
        MsgBox "No data in cell '" & dfCellAddress & "' or below.", _
            vbCritical, ProcName
        Exit Sub
    End If
    
    ' Create a reference to the workbook.
    Dim wb As Workbook: Set wb = dws.Parent
    
    ' Attempt to create a reference to the After sheet.
    Dim ash As Object
    On Error Resume Next
        Set ash = wb.Sheets(ashName)
    On Error GoTo ClearError
    If ash Is Nothing Then
        MsgBox "There is no sheet named '" & ashName & "'.", _
            vbCritical, ProcName
        Exit Sub
    End If
    
    ' Attempt to create a reference to the Source worksheet, the worksheet
    ' before the After sheet.
    Dim sws As Worksheet
    On Error Resume Next
        Set sws = wb.Sheets(ashName).Previous
    On Error GoTo ClearError
    If sws Is Nothing Then
        MsgBox "There is no worksheet before sheet '" & ashName & "'.", _
            vbCritical, ProcName
        Exit Sub
    End If
    
    ' Check if the Source worksheet's name begins with the Base name.
    Dim swsName As String: swsName = sws.Name
    If InStr(1, swsName, swsBaseName, vbTextCompare) <> 1 Then
        MsgBox "The worksheet name doesn't start with '" & swsBaseName & "'.", _
            vbCritical, ProcName
        Exit Sub
    End If
    
    ' Check if there is a formula containing the Base name
    ' in the first Destination cell.
    Dim dFormula As Variant
    Dim dPos As String
    dFormula = CStr(dfCell.Formula)
    dPos = InStr(1, dFormula, swsBaseName, vbTextCompare)
    If dPos = 0 Then
        MsgBox "The Base name '" & swsBaseName & "' was not found in cell '" _
            & dfCellAddress & "'.", vbCritical, ProcName
        Exit Sub
    End If
    
    ' Check if the formula is referencing ('!') the Base name.
    dFormula = Right(dFormula, Len(dFormula) - dPos + 1)
    dPos = InStr(dFormula, "!")
    If dPos = 0 Then
        MsgBox "The cell '" & dfCellAddress _
            & "' doesn't contain a worksheet reference.", vbCritical, ProcName
        Exit Sub
    End If
    
    ' Determine the New name (closing parentheses: ')').
    dFormula = Left(dFormula, dPos - 1)
    dPos = InStr(dFormula, ")")
    Dim NewName As String
    If dPos = 0 Then
        NewName = swsBaseName
    Else
        NewName = Left(dFormula, dPos)
    End If
    
    ' Check if the New name is different than the Source worksheet name.
    If StrComp(NewName, swsName, vbTextCompare) = 0 Then
        MsgBox "The formulas already contain " _
            & "the correct worksheet references.", vbExclamation, ProcName
        Exit Sub
    End If
    
    ' Account for the single quote issues (').
    If StrComp(swsName, swsBaseName, vbTextCompare) <> 0 Then
        swsName = "'" & swsName & "'"
    End If
    If NewName <> swsBaseName Then
        NewName = "'" & NewName & "'"
    End If

    ' Replace the worksheet references in the Destination column range.
    
    Dim dcrg As Range: Set dcrg = dws.Range(dfCell, dlCell)
    
    ' This should work in many cases...
    dFormula = Replace(dfCell.Formula, NewName, swsName, , , vbTextCompare)
    dcrg.Formula = dFormula '  mimics write first cell and copy down
    
'    ' ... if it doesn't, use the fast array loop version...
'    Dim drCount As Long: drCount = dcrg.Rows.Count
'    Dim dData As Variant
'    If drCount = 1 Then
'        ReDim dData(1 To 1, 1 To 1): dData(1, 1) = dcrg.Value
'    Else
'        dData = dcrg.Formula
'    End If
'    Dim r As Long
'    For r = 1 To drCount
'        dData(r, 1) = Replace(dData(r, 1), NewName, swsName, , , vbTextCompare)
'    Next r
'    dcrg.Formula = dData
    
'    ' ... or use the slow range loop version:
'    Dim dCell As Range
'    For Each dCell In dcrg.Cells
'        dFormula = Replace(dCell.Formula, NewName, swsName, , , vbTextCompare)
'        dCell.Formula = dFormula
'    Next dCell
  
    ' Inform.
    MsgBox "The worksheet reference was changed from '" & NewName & "' to '" _
        & swsName & "'.", vbInformation, ProcName

ProcExit:
    Exit Sub
ClearError:
    Debug.Print "'" & ProcName & "' Rte '" & Err.Number & "':" & vbLf _
        & "    " & Err.Description
    Resume ProcExit
End Sub

EDIT:

To make it work for multiple columns, instead of Dim dcrg... dFormula you could use:

Dim drg As Range
Set drg = dws.Range(dfCell, dlCell).EntireRow.Columns("B:O")

Dim dcrg As Range

For Each dcrg In drg.Columns
    dFormula = Replace( _
        dcrg.Cells(1).Formula, NewName, swsName, , , vbTextCompare)
    dcrg.Formula = dFormula
Next dcrg
Related