vba- downsize my code

[montecarlo2012]

Hello all.
Working on:

sub regre_an ()

Dim H, Z$()
    For Each H In Split("B4:B2 B20:B18 B36:B34 B52:B50 B68:B66 B84:B82")
        Z = Split(H, ":")
        Range(Z(0)).Value2 = Application.Average(Range(Z(1), Range(Z(1)).End(xlToRight)))
    Next
    
  ':::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
    Dim V, S$()
    For Each V In Split("B5:B2 B21:B18 B37:B34 B53:B50 B69:B66 B85:B82")
        S = Split(V, ":")
        Range(S(0)).Value2 = Application.Count(Range(S(1), Range(S(1)).End(xlToRight)))
    Next
  ':::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
   Dim M, N$()
For Each M In Split("B6:B2 B22:B18 B38:B34 B54:B50 B70:B66 B86:B82")
        N = Split(M, ":")
        Range(N(0)).Value2 = Application.Max(Range(N(1), Range(N(1)).End(xlToRight)))
Next
  ':::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
    Dim X, E$()
For Each X In Split("B7:B2 B23:B18 B39:B34 B55:B50 B71:B66 B87:B82")
        E = Split(X, ":")
        Range(E(0)).Value2 = Application.Mode(Range(E(1), Range(E(1)).End(xlToRight)))
Next
end sub

wondering how to shorter this 4 loops.
Please, your feedback is very important
Thank you for reading this.

 

[mikerickson]

Dim oneCell as Range, oneRow as Range

For Each oneCell in Range("B2,B18,B34,B50,B66,B82")
    Set oneRow = Range(oneCell, oneCell.End(xlToRight))
    With oneCell
        .Offset(2,0).Value = WorksheetFunction.Average(oneRow)
        .Offset(3,0).Value = WorksheetFunction.Count(oneRow)
        .Offset(4,0).Value = WorksheetFunction.Max(oneRow)
        .Offset(5,0).Value = WorksheetFunction.Mode(oneRow)
    End With
next oneCell

 

[Marc L]

wondering how to shorter this 4 loops.

Hi, your procedure revamped :​

Sub regre_an()
        Dim V, Rg As Range
    With Application
        For Each V In Split("B2 B18 B34 B50 B66 B82")
            Set Rg = Range(V, Range(V).End(xlToRight))
            Range(V)(3).Resize(, 4).Value2 = .Transpose(Array(.Average(Rg), .Count(Rg), .Max(Rg), .Mode(Rg)))
        Next
    End With
            Set Rg = Nothing
End Sub

 

[Marc L]

A variation according to Mike's code :​

Sub regre_an()
        Dim Rg(1) As Range
    With Application
        For Each Rg(0) In Range("B2,B18,B34,B50,B66,B82")
            Set Rg(1) = Range(Rg(0), Rg(0).End(xlToRight))
            Rg(0)(3).Resize(, 4).Value2 = .Transpose(Array(.Average(Rg(1)), .Count(Rg(1)), .Max(Rg(1)), .Mode(Rg(1))))
        Next
    End With
        Erase Rg
End Sub

 

[montecarlo2012]

Hello. I am grateful for the time you have invested guys.
So far I expect this:

when I run Mike the return

when I run Marc the return

unexpected, the output come in a row, and must be a column.

thanks.

 

[Marc L]

​

My bad as for the Resize part it should be Resize(4) rather than Resize(, 4) so you just must remove the comma,​

​

it's what may happen when the initial post does not have any attachment with the expected result …​

 

[montecarlo2012]

Marc L, Perfect.
I want to sincerely thank you for the time you gave to me. I already mark as solution and like.