Deplete cell values based on a common reference

victoria2207

New Member
Joined
Mar 9, 2018
Messages
17
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
 

Some videos you may like

Excel Facts

How to find 2nd largest value in a column?
MAX finds the largest value. =LARGE(A:A,2) will find the second largest. =SMALL(A:A,3) will find the third smallest

MickG

MrExcel MVP
Joined
Jan 9, 2008
Messages
14,841
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 !!
Code:
[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

New Member
Joined
Mar 9, 2018
Messages
17
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 !!
Code:
[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

 

Watch MrExcel Video

Forum statistics

Threads
1,109,336
Messages
5,528,101
Members
409,802
Latest member
joeino

This Week's Hot Topics

  • Change military grades into rank
    Afternoon all Need help with formula that will change military rank (i.e. 1, 2, 3 into Amn, A1C, SrA). Running IF formula that does not work...
  • VBA COUNTIF SOLUTION
    Hi The following are the errors spread across the several columns from E to Q ie. 13 columns across several sheets with more than 500 rows per...
  • INSERT ROW WITH SPECIFIS TEXT IN A COLUMN
    Hi All! How can identify that that the row to be inserted has to be inserted before 1st row with specific text in column F. If I record the...
  • Auto-Create a monthly Sign in sheet for preschool students
    The image below is what each page looks like. Above is space for the "Child Name" "Month" "Class" School days are obviously Monday-Friday but...
  • VBA vlookup multiple results
    Hi folks, Hopefully someone out there can help. I have a list to vlookup which works (ish). the lookup only picks up the first instance of the...
  • Extract values for earliest/latest times
    I am trying to put together a formula to get the earliest start time, the latest end time from column A for each person in Column B-F without the...
Top