vba- downsize my code

montecarlo2012

Well-known Member
Joined
Jan 26, 2011
Messages
781
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

What does custom number format of ;;; mean?
Three semi-colons will hide the value in the cell. Although most people use white font instead.

mikerickson

MrExcel MVP
Joined
Jan 15, 2007
Messages
24,079
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
 

Marc L

Well-known Member
Joined
Apr 5, 2021
Messages
1,725
Office Version
  1. 2010
Platform
  1. Windows
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:

Marc L

Well-known Member
Joined
Apr 5, 2021
Messages
1,725
Office Version
  1. 2010
Platform
  1. Windows
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
 

montecarlo2012

Well-known Member
Joined
Jan 26, 2011
Messages
781
Office Version
  1. 2010
Platform
  1. Windows

ADVERTISEMENT

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.
 

Marc L

Well-known Member
Joined
Apr 5, 2021
Messages
1,725
Office Version
  1. 2010
Platform
  1. Windows
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 …​
 
Solution

montecarlo2012

Well-known Member
Joined
Jan 26, 2011
Messages
781
Office Version
  1. 2010
Platform
  1. Windows
Marc L, Perfect.
I want to sincerely thank you for the time you gave to me. I already mark as solution and like. (y)
 

Forum statistics

Threads
1,148,108
Messages
5,744,874
Members
423,907
Latest member
zerocool88

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
Top