Deplete cell values based on a common reference

[victoria2207]

Good Afternoon, Please excuse me if something similar has already been posted. I am looking for a simple but robust way to deplete the value of a cell based on a common reference on another sheet. To clarify, Sheet 1 contains hundreds of rows of items in Column A with the current available value in Column B.

Sheet 2 to 34 have various different actions, each of which if carried out will deplete the available resources on Sheet 1, so:

Sheet 1:

[TABLE="width: 152"]
<tbody>[TR]
[TD]Reference
[/TD]
[TD]Value available
[/TD]
[/TR]
[TR]
[TD]AA100
[/TD]
[TD="align: right"]26
[/TD]
[/TR]
[TR]
[TD]AA101
[/TD]
[TD="align: right"]27
[/TD]
[/TR]
[TR]
[TD]AA102
[/TD]
[TD="align: right"]23
[/TD]
[/TR]
[TR]
[TD]AA103
[/TD]
[TD="align: right"]24
[/TD]
[/TR]
[TR]
[TD]AA104
[/TD]
[TD="align: right"]25
[/TD]
[/TR]
[TR]
[TD]AA105
[/TD]
[TD="align: right"]26
[/TD]
[/TR]
[TR]
[TD]AA106
[/TD]
[TD="align: right"]27
[/TD]
[/TR]
[TR]
[TD]AA107
[/TD]
[TD="align: right"]23
[/TD]
[/TR]
[TR]
[TD]AA108
[/TD]
[TD="align: right"]24
[/TD]
[/TR]
[TR]
[TD]AA109
[/TD]
[TD="align: right"]25
[/TD]
[/TR]
[TR]
[TD]AA110
[/TD]
[TD="align: right"]26
[/TD]
[/TR]
[TR]
[TD]AA111
[/TD]
[TD="align: right"]27
[/TD]
[/TR]
[TR]
[TD]AA112
[/TD]
[TD="align: right"]23
[/TD]
[/TR]
</tbody>[/TABLE]

Sheet 2:

[TABLE="width: 106"]
<tbody>[TR]
[TD]Ref
[/TD]
[TD]Item1
[/TD]
[/TR]
[TR]
[TD]AA100
[/TD]
[TD="align: right"]5
[/TD]
[/TR]
[TR]
[TD]AA103
[/TD]
[TD="align: right"]6
[/TD]
[/TR]
[TR]
[TD]AA106
[/TD]
[TD="align: right"]4
[/TD]
[/TR]
[TR]
[TD]AA109
[/TD]
[TD="align: right"]3
[/TD]
[/TR]
[TR]
[TD]AA112
[/TD]
[TD="align: right"]5
[/TD]
[/TR]
</tbody>[/TABLE]


Essentially I want to reduce the 26 available of AA100 by 5 and AA103 by 6, AA104 by 4 etc. possibly using a button press?


I'm hoping there is already some VBA written or another simple way to achieve this.

TIA

Vic2207

 

[MickG]

Try this:-
This code is for data on sheets1 & 2.
If you have similar data to sheet2 on the next 33 sheets and you want to incorporate them in the code let me Know !!

[COLOR="Navy"]Sub[/COLOR] MG09Mar02
[COLOR="Navy"]Dim[/COLOR] Rng [COLOR="Navy"]As[/COLOR] Range, Dn [COLOR="Navy"]As[/COLOR] Range, n [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="Navy"]With[/COLOR] Sheets("Sheet2")
[COLOR="Navy"]Set[/COLOR] Rng = .Range("A2", .Range("A" & Rows.Count).End(xlUp))
[COLOR="Navy"]End[/COLOR] With
[COLOR="Navy"]With[/COLOR] CreateObject("scripting.dictionary")
.CompareMode = vbTextCompare
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
    .Item(Dn.Value) = Dn.Offset(, 1).Value
[COLOR="Navy"]Next[/COLOR]
[COLOR="Navy"]With[/COLOR] Sheets("Sheet1")
    [COLOR="Navy"]Set[/COLOR] Rng = .Range("A2", .Range("A" & Rows.Count).End(xlUp))
[COLOR="Navy"]End[/COLOR] With
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
     [COLOR="Navy"]If[/COLOR] .exists(Dn.Value) [COLOR="Navy"]Then[/COLOR]
        Dn.Offset(, 1).Value = Dn.Offset(, 1).Value - .Item(Dn.Value)
     [COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR] Dn
[COLOR="Navy"]End[/COLOR] With
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick

 

[victoria2207]

Thank you Mick - that worked a treat!

I don't need the code to reference every sheet thank you as I want an individual button push available for each action so I will just tailor the code and have individual macro's for each action.

Thanks again,

Vic2207

Try this:-
This code is for data on sheets1 & 2.
If you have similar data to sheet2 on the next 33 sheets and you want to incorporate them in the code let me Know !!

[COLOR=navy]Sub[/COLOR] MG09Mar02
[COLOR=navy]Dim[/COLOR] Rng [COLOR=navy]As[/COLOR] Range, Dn [COLOR=navy]As[/COLOR] Range, n [COLOR=navy]As[/COLOR] [COLOR=navy]Long[/COLOR]
[COLOR=navy]With[/COLOR] Sheets("Sheet2")
[COLOR=navy]Set[/COLOR] Rng = .Range("A2", .Range("A" & Rows.Count).End(xlUp))
[COLOR=navy]End[/COLOR] With
[COLOR=navy]With[/COLOR] CreateObject("scripting.dictionary")
.CompareMode = vbTextCompare
[COLOR=navy]For[/COLOR] [COLOR=navy]Each[/COLOR] Dn [COLOR=navy]In[/COLOR] Rng
    .Item(Dn.Value) = Dn.Offset(, 1).Value
[COLOR=navy]Next[/COLOR]
[COLOR=navy]With[/COLOR] Sheets("Sheet1")
    [COLOR=navy]Set[/COLOR] Rng = .Range("A2", .Range("A" & Rows.Count).End(xlUp))
[COLOR=navy]End[/COLOR] With
[COLOR=navy]For[/COLOR] [COLOR=navy]Each[/COLOR] Dn [COLOR=navy]In[/COLOR] Rng
     [COLOR=navy]If[/COLOR] .exists(Dn.Value) [COLOR=navy]Then[/COLOR]
        Dn.Offset(, 1).Value = Dn.Offset(, 1).Value - .Item(Dn.Value)
     [COLOR=navy]End[/COLOR] If
[COLOR=navy]Next[/COLOR] Dn
[COLOR=navy]End[/COLOR] With
[COLOR=navy]End[/COLOR] [COLOR=navy]Sub[/COLOR]

Regards Mick

 

[MickG]

You're welcome