Sub ApplyFormula()
    Dim lastRow As Long
    Dim rng As Range
    Dim cell As Range
    Dim rightCell As Range
    
    ' Determine the last row in the first column
    lastRow = Cells(Rows.Count, 1).End(xlUp).Row
    
    ' Set the range to the first column
    Set rng = Range("A1:A" & lastRow)
    
    ' Clear the contents of the entire right column
    Range("B1:B" & Rows.Count).ClearContents
    
    ' Loop through each cell in the range
    For Each cell In rng
        ' Check if the cell is not empty
        If Not IsEmpty(cell) Then
            ' Check if there is a cell to the right
            If cell.Column < Columns.Count Then
                Set rightCell = cell.Offset(0, 1)
                
                ' Apply the formula to the cell to the right
                rightCell.Formula = "= ""*"" & " & cell.Address & " & ""*"""
            End If
        End If
    Next cell
End Sub