vba- downsize my code

montecarlo2012

Well-known Member
Joined
Jan 26, 2011
Messages
984
Office Version
  1. 2010
Platform
  1. Windows
Hello all.
Working on:
VBA Code:
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.
 

Excel Facts

Which came first: VisiCalc or Lotus 1-2-3?
Dan Bricklin and Bob Frankston debuted VisiCalc in 1979 as a Visible Calculator. Lotus 1-2-3 debuted in the early 1980's, from Mitch Kapor.
VBA Code:
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
 
Upvote 0
wondering how to shorter this 4 loops.
Hi, your procedure revamped :​
VBA Code:
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
 
Last edited:
Upvote 0
A variation according to Mike's code :​
VBA 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
 
Upvote 0
Hello. I am grateful for the time you have invested guys.
So far I expect this:
1622339484057.png


when I run Mike the return
1622339577190.png


1622339617046.png


when I run Marc the return

1622339712662.png


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

thanks.
 
Upvote 0
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 …​
 
Upvote 0
Solution
Marc L, Perfect.
I want to sincerely thank you for the time you gave to me. I already mark as solution and like. (y)
 
Upvote 0

Forum statistics

Threads
1,213,521
Messages
6,114,109
Members
448,548
Latest member
harryls

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top