Matheus, por ser novo no forum deveria ler primeiramente as Regras do Forum - viewtopic.php?f=7&t=203, e repeita-la quanto a criação de tópicos e se atentar na parte dos Titulos e não utilizar "Ajuda - Novo por aqui" :
• TÍTULOS
Seja criativo na criação do título para um novo tópico, se imagine criando um título para uma notícia de um
jornal onde se lê o título já tendo uma ideia do que se trata o tópico, evite palavras vagas e não use termos como:
Urgente, Help, Ajuda, Por Favor, etc...

Quanto a sua questão, o ideal é anexar um modelo reduzido e compactado (zip, rar) conforme as regras do forum, pois pelo que postou não tem como saber por exemplo "coluna B vem representada por valores como por exemplo: "1 dia", "67 dias", "150 dias" sempre variando" e "que se crie uma coluna "H" com a formula =VALOR(ESQUERDA(Href;PROCURAR(" ";Href)-1))"

[]s

Primeiramente gostaria de pedir minhas sinceras Desculpas.
Gostaria desde já agradecer pela paciência e o suporte.

Pois bem, tentei resumir a planilha e assim que ela seria ao final(com a montagem do gráfico da curva S).
Note que na coluna B os valores não estão mais com o sufixo "dia" ou "dias" e que a soma só se da a partir de B3;
Note também que em C14 preciso rescrever a data para que possa dar sequencia em C15, C16 em diante como períodos semestrais adicionando 7 dias.

Att,
Matheus Gurgel.

Consegui alguns avanços onde:
1ª SUB adiciona o texto "TOTAL" a célula após a "entrada" do usuário
2ª SUB verifica se na primeira coluna o a formatação da célula esta em NEGRITO:
- SE FALSO e a célula da segunda coluna não estiver em branco ele chama a função de "identificação de números"
assim revalida o valor da célula apenas para valores NUMÉRICOS

Public Sub contagem_total()
Dim contagem As Integer

contagem = WorksheetFunction.CountA(Columns(1))
contagem = contagem + 1
Range("A" & contagem).Font.Bold = True
Range("A" & contagem) = "TOTAL"

End Sub

Public Sub soma_columnB()
Dim iRow As Integer
Dim x As Integer

For iRow = 2 To WorksheetFunction.CountA(Columns(1)) - 1
      If Cells(iRow, 1).Font.Bold = False Then
        If Cells(iRow, 2) <> "" Then
            x = lfRetiraNumeros("B95")
            Cells(iRow, 2) = x
        End If
      End If
    Next iRow
End Sub

Public Function lfRetiraNumeros(ByVal vValor As String) As String
    'Atualiza o cálculo automaticamente
    Application.Volatile
 
    'Conta a quantidade de caracteres
    Dim vQtdeCaract As Long
    Dim vControle   As Boolean
 
    vQtdeCaract = Len(vValor)
    vControle = False
 
    'Para cada caractere identifica se é número ou texto
    For i = 1 To vQtdeCaract
        'Se for número adiciona no retorno da função
        If IsNumeric(Mid(vValor, i, 1)) Then
            If vControle = True And lfRetiraNumeros <> vbNullString Then
                lfRetiraNumeros = lfRetiraNumeros + " "
            End If
            vControle = False
            lfRetiraNumeros = lfRetiraNumeros & Mid(vValor, i, 1)
        Else
            vControle = True
        End If
    Next
 
End Function

Olá,

Estou conseguindo alguns avanços e gostaria da ajuda de vocês
para encontrar erro no seguinte codigo pois esta dando o erro "Tipos incompativeis":

Obs: variaveis contagem e abc declaradas global

Public Function concluido()


For orow = (contagem + 2) To abc

        For iRow = 2 To WorksheetFunction.CountA(Columns(1)) - 1
        
            If Cells(iRow, 1).Font.Bold = False Then
                
                dia_c = Right(Range("C" & iRow), 8)
                dia_c = CDate(dia_c)
                
                dia_d = Right(Range("D" & iRow), 8)
                dia_d = CDate(dia_d)
                
                
                    If CDate(Range("D" & orow)) > dia_d Then
                        dias_z = dias_z + Range("J" & iRow)
                        Range("E" & orow) = dias_z
                        Range("E" & orow) = Format(Cells(orow, 5), "0.00%")
                        Range("E" & orow).HorizontalAlignment = xlCenter
                    Else
                        
                        dias_x = WorksheetFunction.NetworkDays(dia_c, CDate(Range("D" & orow)))
                        dias_y = (dias_x * Range("J" & iRow)) / lfRetiraNumeros(Cells(iRow, 2))
                        dias_z = dias_z + dias_y
                        Range("E" & orow) = dias_z
                        Range("E" & orow) = Format(Cells(orow, 5), "0.00%")
                        Range("E" & orow).HorizontalAlignment = xlCenter
                    End If
            End If
                
        Next
        
Next
End Function