Correction of two algorithms calculates empty lines - vba

Question

Is it possible to correct the two algorithms? when I do a filtering by criteria, I calculate two columns, "Pareto_Analysis" and "cumulates", my problem is: that the two algorithms don't calculate the data filtered, but calculate all the lines.
Here is an example of filtering on this screen printer
Code algorithm for "Pareto_Analysis":
Sub calculDefect()
Dim ws As Worksheet
Set ws = Sheet7
With ws
Const SourceColumn As String = "G"
Const DestColumn As String = "K"
Const TotalCell As String = "H4" 'total defect of all defect
Const StartRow As Integer = 11
Const EndRow As Integer = 100
For i = StartRow To EndRow
ws.Range(DestColumn & i).Formula = "=(" & SourceColumn & i & "/" & TotalCell & ")*100"
Next i
End With
End Sub
Code algorithm for "cumule":
Sub calculatCumule()
Dim ws As Worksheet
Set ws = Sheet7
With ws
LastRow = ActiveSheet.Cells(Rows.Count, 11).End(xlUp).Row
Range("L11") = Range("K11").Value
Range("L12").FormulaR1C1 = "=R[-1]C+RC[-1]"
Range("L12").AutoFill Destination:=Range("L12:L" & LastRow & "")
End With
End Sub
To clarify the question further, here are some more screen dumps:
Here I chose the criteria I wanted:
Displays the data I have chosen:
Calculate the "pareto" column based on the column "Quantity_prod" and the column"cumule" based on the column "pareto":
And if you notice in the last picture the rest of the columns has 0 and 100 that repeats, normally should just calculate the 4 lines.

Answer 1

Try the 2 modified 'Algorithms" code below.
First, you need to run Sub calculDefect, and after run Sub calculatCumule.
Sub calculDefect()
Dim ws As Worksheet
Const SourceColumn As String = "G"
Const DestColumn As String = "K"
Const TotalCell As String = "H4" 'total defect of all defects
Const StartRow As Long = 11
Dim EndRow As Long, i As Long
Set ws = Sheet7
With ws
EndRow = .Range("G" & StartRow).End(xlDown).Row '<-- get last row with data in Column G
For i = StartRow To EndRow
.Range(DestColumn & i).Formula = "=(" & SourceColumn & i & "/" & TotalCell & ")*100"
Next i
End With
End Sub
'====================================================================
Sub calculatCumule()
Dim ws As Worksheet
Dim LastRow As Long
Set ws = Sheet7
With ws
LastRow = .Cells(.Rows.Count, "K").End(xlUp).Row '<-- get last row with data in Column K
.Range("L11") = .Range("K11").Value
.Range("L12").FormulaR1C1 = "=R[-1]C+RC[-1]"
.Range("L12:L" & LastRow).FillDown
End With
End Sub
Screen-shot of the results I've got running this code:
Edit 1: same 2 "algorithms" that work when you filter the data:
Sub calculDefect()
Dim ws As Worksheet
Const SourceColumn As String = "G"
Const DestColumn As String = "K"
Const TotalCell As String = "H4" 'total defect of all defects
Const StartRow As Long = 11
Dim EndRow As Long, i As Long
Dim VisRng As Range, C As Range
Set ws = Sheet7
With ws
EndRow = .Range("G" & StartRow).End(xlDown).Row '<-- get last row with data in Column G
' set visible range to only filtered cells in Column G
Set VisRng = .Range(Range(SourceColumn & StartRow), Range(SourceColumn & EndRow)).SpecialCells(xlCellTypeVisible)
.Range(TotalCell).Formula = WorksheetFunction.Sum(VisRng) '<-- re-calculate Total defects according to visible range
For Each C In VisRng
.Range(DestColumn & C.Row).Formula = "=(" & SourceColumn & C.Row & "/" & TotalCell & ")*100"
Next C
End With
End Sub
'=================================================================
Sub calculatCumule()
Dim ws As Worksheet
Dim VisRng As Range, C As Range
Dim StartRow As Long
Dim LastRow As Long
Set ws = Sheet7
With ws
LastRow = .Cells(.Rows.Count, "K").End(xlUp).Row '<-- get last row with data in Column K
StartRow = 11 '<-- init value
' set visible range to only filtered cells in Column G
Set VisRng = .Range(Range("K" & StartRow), Range("K" & LastRow)).SpecialCells(xlCellTypeVisible)
StartRow = VisRng.Item(1).Row '<-- update first row in visible range
For Each C In VisRng
If C.Row = StartRow Then
.Range("L" & C.Row) = .Range("K" & C.Row).Value
Else
.Range("L" & C.Row).Formula = "=SUBTOTAL(9,K" & StartRow & ":K" & C.Row & ")"
End If
Next C
End With
End Sub
Screen-shot of the results I've got running this code when filtering "Type_defect" to CPE02: