goal seek automation on a range of cells

daveandsiobhan

New Member
Joined
Apr 1, 2013
Messages
2
Hi Folks,
Hope somebody out there can help on this one. This is my first post and I have looked on the forums but can't see anything close enough to what I need. I wanted to set up a macro to automate goal seek on a range of cells. I have only very basic macro experience so am struggling a little. I've attached a short extract below of the spreadsheet I'm working on (the full one has a few thousand lines of data) which I hope illustrates what I'm trying to do. I hope this is enough info.
Many thanks in anticipation.
Dave

janfebmaraprmayjunjulaugAvgNew Avg
0000000000
34204343434343433539
33434444444444442343Goal seek
23443454554554554554554588492
13113232323232326627set cell
13434343434343431439to value
22133233333333333333333346319by changing cell
1111373417341734173417341734174642593
107109202020202020242
103824343434343432455
99541061061061061061066498
9527168168168168168168433141
910231231231231231231302184
87282932932932932932933234
835535635635635635635633284
798341841841841841841855334
75110481481481481481481556384
7213854354354354354354366433
6816560660660660660660641483

<colgroup><col style="width: 48pt;" span="10" width="64"> <col style="width: 15pt; mso-width-source: userset; mso-width-alt: 731;" span="2" width="20"> <col style="width: 80pt; mso-width-source: userset; mso-width-alt: 3876;" width="106"> <col style="width: 48pt;" width="64"> <tbody>
</tbody>
 

Excel Facts

Lock one reference in a formula
Need 1 part of a formula to always point to the same range? use $ signs: $V$2:$Z$99 will always point to V2:Z99, even after copying
Excel 2010
A
B
C
D
E
F
G
H
I
J
K
L
M
N
1
jan
feb
mar
apr
may
jun
jul
aug
Avg
New Avg
Mar
Offset
-7
2
3
34
20
43
43
43
43
43
43
35
39
4
33
43
44
44
44
44
44
44
23
43
Goal seek
5
234
434
545
545
545
545
545
545
88
492
6
13
11
32
32
32
32
32
32
66
27
set cell
7
13
43
43
43
43
43
43
43
14
39
to value
8
221
332
333
333
333
333
333
333
46
319
by changing cell
9
111
137
3417
3417
3417
3417
3417
3417
464
2594
10
107
109
20
20
20
20
20
20
2
42
11
103
82
43
43
43
43
43
43
24
55
12
99
54
106
106
106
106
106
106
64
99
13
95
27
168
168
168
168
168
168
433
141
14
91
231
231
231
231
231
231
302
185
15
87
28
293
293
293
293
293
293
3
234
16
83
55
356
356
356
356
356
356
33
284
17
79
83
418
418
418
418
418
418
55
334
18
75
110
481
481
481
481
481
481
556
384
19
72
138
543
543
543
543
543
543
66
434
20
68
165
606
606
606
606
606
606
41
484

<tbody>
</tbody>
Sheet1
Changing cell L1 to desired month fixes offsets in VBA code.

Worksheet Formulas
Cell
Formula
N1
=-10+MATCH(L1,$A$1:$J$1,0)
J2
=AVERAGE(A2:H2)
J3
=AVERAGE(A3:H3)
J4
=AVERAGE(A4:H4)
J5
=AVERAGE(A5:H5)
J6
=AVERAGE(A6:H6)
J7
=AVERAGE(A7:H7)
J8
=AVERAGE(A8:H8)
J9
=AVERAGE(A9:H9)
J10
=AVERAGE(A10:H10)
J11
=AVERAGE(A11:H11)
J12
=AVERAGE(A12:H12)
J13
=AVERAGE(A13:H13)
J14
=AVERAGE(A14:H14)
J15
=AVERAGE(A15:H15)
J16
=AVERAGE(A16:H16)
J17
=AVERAGE(A17:H17)
J18
=AVERAGE(A18:H18)
J19
=AVERAGE(A19:H19)
J20
=AVERAGE(A20:H20)

<tbody>
</tbody>

<tbody>
</tbody>

Try Code below.
Code:
Sub MutipleGoalSeek()
    Dim aCell As Range
    
    'Speeding Up VBA Code
    With Application
        .ScreenUpdating = False 'Prevent screen flickering
        '.Calculation = xlCalculationManual 'Preventing calculation
        .DisplayAlerts = False 'Turn OFF alerts
        .EnableEvents = False 'Prevent All Events
    End With
       
    On Error Resume Next                'This prevents an error at blank cells
    For Each aCell In Range("J2:J" & Cells(Rows.Count, "J").End(xlUp).Row)
        aCell.GoalSeek Goal:=aCell.Offset(0, -1), ChangingCell:=aCell.Offset(0, Range("N1").Value)
    Next aCell
        
    'Speeding Up VBA Code
    With Application
        .ScreenUpdating = True 'Prevent screen flickering
        '.Calculation = xlAutomatic 'Preventing calculation
        .DisplayAlerts = True 'Turn OFF alerts
        .EnableEvents = True 'Prevent All Events
    End With
    
End Sub
Does it help? Biz
 
Last edited:
Upvote 0
Wow!!
Awesome!!
I won't pretend to understand exactly what you did there Biz, but that was spot on!! Thank you so much for your time, much appreciated!!
Many thanks
Dave


Excel 2010
A
B
C
D
E
F
G
H
I
J
K
L
M
N
1
jan
feb
mar
apr
may
jun
jul
aug
Avg
New Avg
Mar
Offset
-7
2
3
34
20
43
43
43
43
43
43
35
39
4
33
43
44
44
44
44
44
44
23
43
Goal seek
5
234
434
545
545
545
545
545
545
88
492
6
13
11
32
32
32
32
32
32
66
27
set cell
7
13
43
43
43
43
43
43
43
14
39
to value
8
221
332
333
333
333
333
333
333
46
319
by changing cell
9
111
137
3417
3417
3417
3417
3417
3417
464
2594
10
107
109
20
20
20
20
20
20
2
42
11
103
82
43
43
43
43
43
43
24
55
12
99
54
106
106
106
106
106
106
64
99
13
95
27
168
168
168
168
168
168
433
141
14
91
231
231
231
231
231
231
302
185
15
87
28
293
293
293
293
293
293
3
234
16
83
55
356
356
356
356
356
356
33
284
17
79
83
418
418
418
418
418
418
55
334
18
75
110
481
481
481
481
481
481
556
384
19
72
138
543
543
543
543
543
543
66
434
20
68
165
606
606
606
606
606
606
41
484

<tbody>
</tbody>
Sheet1
Changing cell L1 to desired month fixes offsets in VBA code.

Worksheet Formulas
Cell
Formula
N1
=-10+MATCH(L1,$A$1:$J$1,0)
J2
=AVERAGE(A2:H2)
J3
=AVERAGE(A3:H3)
J4
=AVERAGE(A4:H4)
J5
=AVERAGE(A5:H5)
J6
=AVERAGE(A6:H6)
J7
=AVERAGE(A7:H7)
J8
=AVERAGE(A8:H8)
J9
=AVERAGE(A9:H9)
J10
=AVERAGE(A10:H10)
J11
=AVERAGE(A11:H11)
J12
=AVERAGE(A12:H12)
J13
=AVERAGE(A13:H13)
J14
=AVERAGE(A14:H14)
J15
=AVERAGE(A15:H15)
J16
=AVERAGE(A16:H16)
J17
=AVERAGE(A17:H17)
J18
=AVERAGE(A18:H18)
J19
=AVERAGE(A19:H19)
J20
=AVERAGE(A20:H20)

<tbody>
</tbody>

<tbody>
</tbody>

Try Code below.
Code:
Sub MutipleGoalSeek()
    Dim aCell As Range
    
    'Speeding Up VBA Code
    With Application
        .ScreenUpdating = False 'Prevent screen flickering
        '.Calculation = xlCalculationManual 'Preventing calculation
        .DisplayAlerts = False 'Turn OFF alerts
        .EnableEvents = False 'Prevent All Events
    End With
       
    On Error Resume Next                'This prevents an error at blank cells
    For Each aCell In Range("J2:J" & Cells(Rows.Count, "J").End(xlUp).Row)
        aCell.GoalSeek Goal:=aCell.Offset(0, -1), ChangingCell:=aCell.Offset(0, Range("N1").Value)
    Next aCell
        
    'Speeding Up VBA Code
    With Application
        .ScreenUpdating = True 'Prevent screen flickering
        '.Calculation = xlAutomatic 'Preventing calculation
        .DisplayAlerts = True 'Turn OFF alerts
        .EnableEvents = True 'Prevent All Events
    End With
    
End Sub
Does it help? Biz
 
Upvote 0
Wow!!
Awesome!!
I won't pretend to understand exactly what you did there Biz, but that was spot on!! Thank you so much for your time, much appreciated!!
Many thanks
Dave
Glad it helped you. Thx for feedback.
 
Upvote 0

Forum statistics

Threads
1,213,536
Messages
6,114,208
Members
448,554
Latest member
Gleisner2

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