Need an Autofill VBA

[LalitPandey87]

In that case need to post new code.

[LalitPandey87]

Use this:

Private Sub Worksheet_Change(ByVal Target As Range)


    If Target.Column = 3 Then
        Call lmp_Test_WithFormula
    End If


End Sub

Sub lmp_Test_WithFormula()


    Dim rngData                 As Range
    Dim rngFindData             As Range
    Dim rngCell                 As Range


    Const strShtName            As String = "Sheet3"
    Const strDataStartCell      As String = "A2"
    Const strValueToCheckCell   As String = "C2"


    Application.Calculation = xlCalculationManual
    With ThisWorkbook
        With .Worksheets(strShtName)
            Set rngData = .Range(strDataStartCell)
            Set rngData = rngData.Resize(.Cells(.Rows.Count, rngData.Column).End(xlUp).Row)
            If WorksheetFunction.CountA(rngData) Then
                Set rngFindData = rngData.Offset(, 2)
                If WorksheetFunction.CountA(rngFindData) Then
                    For Each rngCell In rngFindData
                        rngCell.Offset(, 1).Value = vbNullString
                        If LenB(Trim(rngCell.Value)) > 0 Then
                            rngCell.Offset(, 1).FormulaArray = "=INDEX(" & rngData.Offset(, 1).Address & ", MIN(IF((" & rngData.Address & "=" & rngCell.Address(0, 1) & "),ROW(" & rngData.Address & "),""""))-1)"
                            rngCell.Offset(, 2).FormulaArray = "=MIN(IF((" & rngData.Address & "=" & rngCell.Address(0, 1) & ")," & rngData.Offset(, 1).Address & ",""""))"
                            rngCell.Offset(, 3).FormulaArray = "=MAX(IF((" & rngData.Address & "=" & rngCell.Address(0, 1) & ")," & rngData.Offset(, 1).Address & ",""""))"
                            rngCell.Offset(, 4).FormulaArray = "=INDEX(" & rngData.Offset(, 1).Address & ", MAX(IF((" & rngData.Address & "=" & rngCell.Address(0, 1) & "),ROW(" & rngData.Address & "),""""))-1)"
                        End If
                    Next rngCell
                End If
            End If
        End With
    End With
    Application.Calculation = xlCalculationAutomatic
    
    Set rngData = Nothing
    Set rngFindData = Nothing
    Set rngCell = Nothing
    
End Sub

[mrprofit]

the formula for max and min is misplaced, i corrected it, but the result in F5 and G5 is 0, which should be 101.66, D6:D9 should have no value nor 0, thank you for the time to help me with this,