ExcelBanter

ExcelBanter (https://www.excelbanter.com/)
-   Excel Programming (https://www.excelbanter.com/excel-programming/)
-   -   Simple Macro Modification (https://www.excelbanter.com/excel-programming/329457-simple-macro-modification.html)

[email protected]

Simple Macro Modification
 
Hi All!

I know this should be a simple change, however it is currently eluding
me for some reason.

The code below finds groupings of values over 150 and stops after the
values that go below 150. It then lists all of the averaged groupings.


What I now need to do is when the value is over 150, it will average
the next 12 cells below in the column and then keep doing that for the
entire range. So basically, instead of averaging the various groupings
over 150, it needs to average the groupings of 12 cells that begin with
a value over 150. I hope that I explained that thoroughly enough!

The following is the code that I currently have:

Option Explicit
Sub AvgGT15()
Dim AOI As Range
Dim StoreResult As Range
Dim c As Range
Dim i As Long
Dim Result()

Set StoreResult = [M1]
Set AOI = [D1:D52111]
[M1:M52111].ClearContents

i = 0
ReDim Preserve Result(i)

For Each c In AOI
If c.Value < 150 Then
If Result(0) = 150 Then
StoreResult.Value =
Application.WorksheetFunction.Average(Result())
Set StoreResult = StoreResult.Offset(1, 0)
End If
i = 0
Result(0) = 0
Else
ReDim Preserve Result(i)
Result(i) = c.Value
i = i + 1
End If
Next c

If Result(0) = 150 Then StoreResult.Value = _
Application.WorksheetFunction.Average(Result())

End Sub


That's it!!! Please post suggestions and modifications!

Thanks in advance,

Kris Taylor
www.QuestOfAges.org Administrator


Bernie Deitrick

Simple Macro Modification
 
Kris,

A bit unclear on what you want to do, by maybe the code below will get you
going in the right direction....

HTH,
Bernie
MS Excel MVP

Sub AvgGT15Ver2()
Dim AOI As Range
Dim StoreResult As Range
Dim c As Range

Set StoreResult = [M1]
Set AOI = [D1:D52] '111]
[M1:M52] '111].ClearContents

For Each c In AOI
If c.Value 150 Then
StoreResult.Value = Application.Average( _
c.Offset(1, 0).Resize(12, 1))
Set StoreResult = StoreResult.Offset(1, 0)
End If
Next c
End Sub


wrote in message
ups.com...
Hi All!

I know this should be a simple change, however it is currently eluding
me for some reason.

The code below finds groupings of values over 150 and stops after the
values that go below 150. It then lists all of the averaged groupings.


What I now need to do is when the value is over 150, it will average
the next 12 cells below in the column and then keep doing that for the
entire range. So basically, instead of averaging the various groupings
over 150, it needs to average the groupings of 12 cells that begin with
a value over 150. I hope that I explained that thoroughly enough!

The following is the code that I currently have:

Option Explicit
Sub AvgGT15()
Dim AOI As Range
Dim StoreResult As Range
Dim c As Range
Dim i As Long
Dim Result()

Set StoreResult = [M1]
Set AOI = [D1:D52111]
[M1:M52111].ClearContents

i = 0
ReDim Preserve Result(i)

For Each c In AOI
If c.Value < 150 Then
If Result(0) = 150 Then
StoreResult.Value =
Application.WorksheetFunction.Average(Result())
Set StoreResult = StoreResult.Offset(1, 0)
End If
i = 0
Result(0) = 0
Else
ReDim Preserve Result(i)
Result(i) = c.Value
i = i + 1
End If
Next c

If Result(0) = 150 Then StoreResult.Value = _
Application.WorksheetFunction.Average(Result())

End Sub


That's it!!! Please post suggestions and modifications!

Thanks in advance,

Kris Taylor
www.QuestOfAges.org Administrator




[email protected]

Simple Macro Modification
 
Bernie,

Thanks for your reply. I don't believe that I explained myself
thoroughly enough for you. What your code does is average the next 12
cells after the occurence over 150. What I want is to average the 12
cells,including the first occurence over 150 which did not occur in
your code, and then look for the next occurence over 150 that does not
fall into one of the twelve already averaged above.

I'll try to demonstrate what I need. As you can see below, the 705.25
comes from the 150 all the way down to the 541 value. Then, the 2nd
value comes from 2225 all the way down to 151. From there it should
continue down. Hopefully this is clear enough!

Values (Col D) Averages Obtained (Col M)
15 705.25
7 354.8333333
5
150
25
12
47
899
12
6578
23
65
54
57
541
45
2225
567
51
11
17
15
889
87
96
35
114
151
445
12
14
45

Please post comments and suggestions!

Thanks,

Kris Taylor
www.QuestOfAges.org Administrator


Bernie Deitrick

Simple Macro Modification
 
Kris,

Try this version.

HTH,
Bernie
MS Excel MVP


Sub AvgGT15Ver3()
Dim AOI As Range
Dim StoreResult As Range
Dim c As Long

Set StoreResult = [M1]
Set AOI = [D1:D52111]
[M1:M52111].ClearContents

For c = 1 To AOI.Cells.Count
If AOI.Cells(c).Value 150 Then
StoreResult.Value = Application.Average( _
AOI.Cells(c).Resize(12, 1))
Set StoreResult = StoreResult.Offset(1, 0)
c = c + 12
End If
Next c
End Sub



wrote in message
oups.com...
Bernie,

Thanks for your reply. I don't believe that I explained myself
thoroughly enough for you. What your code does is average the next 12
cells after the occurence over 150. What I want is to average the 12
cells,including the first occurence over 150 which did not occur in
your code, and then look for the next occurence over 150 that does not
fall into one of the twelve already averaged above.

I'll try to demonstrate what I need. As you can see below, the 705.25
comes from the 150 all the way down to the 541 value. Then, the 2nd
value comes from 2225 all the way down to 151. From there it should
continue down. Hopefully this is clear enough!

Values (Col D) Averages Obtained (Col M)
15 705.25
7 354.8333333
5
150
25
12
47
899
12
6578
23
65
54
57
541
45
2225
567
51
11
17
15
889
87
96
35
114
151
445
12
14
45

Please post comments and suggestions!

Thanks,

Kris Taylor
www.QuestOfAges.org Administrator




[email protected]

Simple Macro Modification
 
Bernie,

It wasn't adding the exact right numbers, so I changed the last line to
c=c + 11 and everything works PERFECTLY!

Thanks for your hard work and dedication!

Kris Taylor
www.QuestOfAges.org



All times are GMT +1. The time now is 07:27 PM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
ExcelBanter.com