Gibuja

Pessoal, resolvi o problema da seguinte maneira: antes eu havia criado uma função dentro de um módulo. Entretanto, estava dando o problema de redundância, assim, na planilha mesmo criei duas rotinas, uma sendo a função mesmo e outra para chamar a função a cada alteração de uma célula específica.
 
O código ficou assim:
Sub AjustePeriodicidade() Dim Status As Range Dim LinhaAtual As Integer Dim UltimoAjuste As String Dim LinhaAcima As Integer Dim DiferencaData As Double Dim CalculoData As Double Dim Contador As Double Dim Ajuste As String Dim NumeroLinhas As Integer LinhaAtual = ActiveCell.Row Set Status = Range("R" & LinhaAtual) LinhaAcima = LinhaAtual - 1 DiferencaData = 720 Set Tabela = Range("A2:S" & LinhaAcima) NumeroLinhas = Tabela.Rows.Count TV = Range("L" & LinhaAtual) TAG = Range("G" & LinhaAtual) If TV = "Inicial" Then If Status = "Aprovado" Then Ajuste = "Manter" Else Ajuste = "Reduzir" End If Else For Contador = 1 To NumeroLinhas If Tabela.Cells(Contador, 7) = TAG Then CalculoData = Tabela.Cells(LinhaAtual, 1) - Tabela.Cells(Contador, 1) If CalculoData < DiferencaData Then UltimoAjuste = Tabela.Cells(Contador, 19) End If End If Next Contador If Status = "Aprovado" Then If UltimoAjuste = "Extender" Then Ajuste = "Extender" ElseIf UltimoAjuste = "Manter" Then Ajuste = "Extender" ElseIf UltimoAjuste = "Reduzir" Then Ajuste = "Periodicidade Inicial" ElseIf UltimoAjuste = "Reduzir ao Máximo" Then Ajuste = "Reduzir" ElseIf UltimoAjuste = "Periodicidade Inicial" Then Ajuste = "Extender" End If ElseIf Status = "Reprovado" Then If UltimoAjuste = "Extender" Then Ajuste = "Periodicidade Inicial" ElseIf UltimoAjuste = "Manter" Then Ajuste = "Reduzir" ElseIf UltimoAjuste = "Reduzir" Then Ajuste = "Reduzir ao Máximo" ElseIf UltimoAjuste = "Reduzir ao Máximo" Then Ajuste = "Troca de Instrumento" ElseIf UltimoAjuste = "Periodicidade Inicial" Then Ajuste = "Reduzir" End If End If End If Application.EnableEvents = False Range("S" & LinhaAtual).Value = Ajuste Application.EnableEvents = TrueEnd SubPrivate Sub Worksheet_Change(ByVal Target As Range) Dim CelulaChave As Range Dim LinhaAtual As Integer LinhaAtual = ActiveCell.Row 'Celula que sofrerá a alteação Set CelulaChave = Range("R" & LinhaAtual) If Not Application.Intersect(CelulaChave, Range(CelulaChave.Address)) Is Nothing Then ' Código a ser executado a cada alteração do STATUS Call AjustePeriodicidade End If Application.EnableEvents = TrueEnd Sub