Составить вектор из сумм элементов матрицы, больших среднего геометрического, по строкам

sub prog1()
dim a() as integer
dim b() as integer
 
n=inputbox("Vvedite zn n")
m=inputbox("Vvedite zn m")
 
redim a(n,m)
redim b(n)
 
for i=1 to n 
for j=1 to m
a(i,j)=cells(i,j)
next j,i
 
s=0
p=1
 
for i=1 to n 
for j=1 to m
  p=p*a(i,j)
  b(i)=b(i)+a(i,j)
next j,i
 
 f=p^(1/n*m)' ср.геометрическое
 x=1
for i=1 to n
  if b(i)>f then 
  cells(n+3,x)=b(i)
  x=x+1
  end if
next i
 
end sub

    With WorksheetFunction
        MsgBox .GeoMean([a:a])
    End With

 Sub iGeoMean()
    With ActiveSheet
        If MsgBox("Создать колонку со своими числами ?", vbInformation Or vbYesNo) = vbNo Then Exit Sub
        Set R = .[a:a]: R.Insert
        For i = 1 To 10: .Cells(i, 1) = i * 2: Next
        With WorksheetFunction
            If MsgBox("Средне-геометрическое = " & .GeoMean(R) & vbCrLf & _
            "Удалить расчеты ?", vbYesNo Or vbInformation) = vbNo Then Exit Sub
            R.Delete
        End With
    End With
End Sub

'Option Explicit
 
Sub VectoR()
    Const shn = "Составить вектор"
    '------------ !
    n = 7
    m = 12
    '------------ !
    tx = _
    "Сейчас будет созданн новый лист с расчетами" & vbCrLf & _
    "Введите значения [n * m]" & vbCrLf & _
    "примерно так-же как внизу:"
    While b = False
        x = InputBox(tx, , n & "*" & m)
        If Len(x) Then
            x = Split(x, "*")
            b = UBound(x) = 1
            If b Then
                If IsNumeric(Trim(x(0))) Then n = Val(x(0)) Else b = 0
                If IsNumeric(Trim(x(1))) Then m = Val(x(1)) Else b = 0
            End If
        Else: Exit Sub
        End If
    Wend
 
    Application.DisplayAlerts = False
    If SheetExists(shn) Then Worksheets(shn).Delete
    'Создание таблицы
    With Worksheets.Add: .Name = shn
        With .Cells(1, 1)
            .AddComment
            tx = _
            "Условие:" & vbLf & _
            "Составить вектор из сумм элементов матрицы," & vbLf & _
            "больших среднего геометрического, по строкам"
            .Comment.Text Text:=tx
            .Comment.Shape.TextFrame.AutoSize = True
            .Value = "Matrix !"
        End With
        With .Range(.Cells(1, 1), .Cells(1, n))
            .Merge 'Объеденение верхней полоски
            .HorizontalAlignment = xlCenter
            For xl = 7 To 10: .Borders(xl).LineStyle = 1: Next 'Границы
            .Interior.ColorIndex = 33 'Цвет
        End With
        .Cells(1, n + 2) = "Сумма по строкам (формулы)"
        With .Range(.Cells(2, n + 2), .Cells(m + 1, n + 2))
            For Each el In .Rows 'Отдельно по каждой
                For xl = 7 To 10: el.Borders(xl).LineStyle = 1: Next 'Границы
            Next
             .Interior.ColorIndex = 35
        End With
        'Заполнение числами похожими на геом.-прогрессию
        For j = 2 To m + 1: For i = 1 To n: .Cells(j, i) = i * j: Next i, j
        '===========Вычисление
        vec = Split(Space(m - 1))
        For j = 2 To m + 1
            geo = WorksheetFunction.GeoMean(.Range(.Cells(j, 1), .Cells(j, n)))
            isum = 0
            For i = 1 To n
                If .Cells(j, i) > geo Then
                    Set r = .Range(.Cells(j, i), .Cells(j, n))
                    For xl = 7 To 10: r.Borders(xl).LineStyle = xlDash: Next   'Границы
                    With .Cells(j, n + 2)
                        .Value = "=SUM(" & r.Address & ")"
                        vec(j - 2) = WorksheetFunction.Sum(r)
                        .AddComment
                        .Comment.Text Text:="Средне-геометрическое:" & vbLf & geo
                        .Comment.Shape.TextFrame.AutoSize = True
                    End With
                    Exit For
                End If
        Next i, j
        tx = _
        "Готово !" & vbCrLf & _
        "Вектор: [" & Join(vec, ", ") & "]" & vbCrLf & _
        "Удалить этот лист ?"
        If MsgBox(tx, 68) = vbNo Then Exit Sub
        .Delete
    End With
    Application.DisplayAlerts = True
End Sub
 
Function SheetExists(ByVal Name$) As Boolean
    On Error Resume Next
    txName = "": txName = Worksheets(Name).Name
    SheetExists = Len(txName)
End Function