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:

Reference	Value available
AA100	26
AA101	27
AA102	23
AA103	24
AA104	25
AA105	26
AA106	27
AA107	23
AA108	24
AA109	25
AA110	26
AA111	27
AA112	23

<tbody>
</tbody>

Sheet 2:

Ref	Item1
AA100	5
AA103	6
AA106	4
AA109	3
AA112	5

<tbody>
</tbody>

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