Multiple target values in one worksheet_change event

Denizz

New Member
Joined
Nov 28, 2016
Messages
5
Greetings,

With the help of various helpful people on the internet, I have a code running to calculate outputs of a large ammount of data automatically. However, I need to expand upon it to improve the accuracy of my calculations. This is what it does:


  • Look up if there is a value entered into column M, starting from row 26 untill the last row of the data.
  • Print this value into two seperate calculation sheets ('calc' and 'calcb') on cell C7 of each calculation sheet.
  • Calculations are then done and two outputs per calculation sheet will result from this, which will then be printed back on the sheet, untill there are no more values for the discharge table used to print on the calculation sheets.

This is the code I have now, fully working:

Code:
Private Sub Worksheet_Change(ByVal Target As Range)
        Dim rij As Integer
        Dim LastRow As Long
        
        LastRow = ActiveSheet.Cells(Rows.Count, "M").End(xlUp).Row
        
        ' Only change if cells have been changed
        If Not (Intersect(Target, Sheets!QH.Range("M26:M" & LastRow)) Is Nothing) Then
           
           'Fills in input for each value
                For Each Target In Worksheets("QH").Range("M26:M" & LastRow).Cells
                Sheets!calc.[C7] = Target.Value
                Sheets!calcb.[C7] = Target.Value
            
                
                'Print values from calc sheet
                Target.Offset(rij, 1) = Sheets!calc.[C36]
                Target.Offset(rij, 2) = Sheets!calc.[U10]
                Target.Offset(rij, 9) = Sheets!calcb.[C36]
                Target.Offset(rij, 10) = Sheets!calcb.[U15]
            Next Target
                        
           End If
    End Sub


This works as intended. However, I need to add another variable before the actual calculations start. I am already aware why it does not work, a Worksheet_Change does not support multiple 'targets' as I have input it below. Yet, after many tries on Google, I have found somewhat similair questions but I simply do not understand how to apply them to my situation. This is what needs to happen, with the 'new' part of it in bold:


  • Look up if there is a value entered into column M (containing discharge data), starting from row 26 untill the last row of the data.
  • Print this value into two seperate calculation sheets ('calc' and 'calcb') on cell C7 of each calculation sheet.
  • Look up if there is a value entered into column H (containing head data), starting from row 26 untill the last row of the data.
  • Print this value into two seperate calculation sheets ('calc' and 'calcb') on cells C9 and C20 of each calculation sheet.
  • Calculations are then done and two outputs per calculation sheet will result from this, which will then be printed back on the sheet, untill there are no more values for the discharge and head tables used to print on the calculation sheets.

The code, with my last attempt at getting it to work, and to get the idea of what I am trying to achieve but it will not work as it is wrong, but I do not know how to fix this:

Code:
    Private Sub Worksheet_Change(ByVal Target As Range)
        Dim rij As Integer
        Dim LastRow As Long
        
        LastRow = ActiveSheet.Cells(Rows.Count, "M").End(xlUp).Row
        
        ' Only change if cells have been changed
        If Not (Intersect(Target, Sheets!QH.Range("M26:M" & LastRow)) Is Nothing) Then
        
        
           'Fills in input for each value
                For Each Target In Worksheets("QH").Range("M26:M" & LastRow).Cells
                Sheets!calc.[C7] = Target.Value
                Sheets!calcb.[C7] = Target.Value
     [B]
        
                For Each Target In Worksheets("QH").Range("H26:H" & LastRow).Cells
                Sheets!calc.[C9] = Target.Value
                Sheets!calc.[C20] = Target.Value
                Sheets!calcb.[C9] = Target.Value
                Sheets!calc.[C20] = Target.Value[/B]
                

                'Print values from calc sheet
                Target.Offset(rij, 1) = Sheets!calc.[C36]
                Target.Offset(rij, 2) = Sheets!calc.[U10]
                Target.Offset(rij, 9) = Sheets!calcb.[C36]
                Target.Offset(rij, 10) = Sheets!calcb.[U15]
            Next Target
                        
           End If
        
    End Sub

Further information: I am running Excel 2016 in English.

I do hope I was able to make myself clear, if not my apologies.

Thanks in advance.
 

Excel Facts

What is the shortcut key for Format Selection?
Ctrl+1 (the number one) will open the Format dialog for whatever is selected.
I am giving this thread a bump, as I still cannot adapt a solution for this problem unfortunally. If anyone has some suggestions, even a nudge in the right directions with regards to terminology on how to expand my code properly, that would truely be awesome.
 
Upvote 0
I am giving this thread a bump, as I still cannot adapt a solution for this problem unfortunally. If anyone has some suggestions, even a nudge in the right directions with regards to terminology on how to expand my code properly, that would truely be awesome.

Denizz,
Welcome to the Forum.
1 - I do not see where do you identify 'rij' except in the Dim statement, without it I don't see how either code will work. I assumed 'rij = Target.Row'
2 - In the modified code you furnished, you have two 'For Each' statements, but only one 'Next'...that is a problem.
3 - You start with the 'ActiveSheet' which I assume is Sheet "QH" in these lines:
Code:
        LastRow = ActiveSheet.Cells(Rows.Count, "M").End(xlUp).Row
        
        ' Only change if cells have been changed
        If Not (Intersect(Target, Sheets!QH.Range("M26:M" & LastRow)) Is Nothing) Then
The 'IF' line above could be shortened to:
Code:
If Not Intersect(Target, Range("M26:M" & LastRow)) Is Nothing Then
4 - Also, the following line:
Code:
For Each Target In Worksheets("QH").Range("M26:M" & LastRow).Cells
would could be shortened to:
Code:
For Each Target In Range("M26:M" & LastRow).Cells
5 - The 2nd FOR statement is a bit confusing. I assume whatever row you are on in column M (Discharge) would be the same row in column H (Head) for EACH calculation.
Therefore the values in columns H and M for each row would both be entered into sheets 'calc' and 'calcb' at the same time and then the calculation would be performed for each Target found.
If my assumptions are correct, the code might look like the following:
Code:
Private Sub Worksheet_Change(ByVal Target As Range)
        Dim rij As Integer
        Dim LastRow As Long
        
        LastRow = ActiveSheet.Cells(Rows.Count, "M").End(xlUp).Row
        
        ' Only change if cells have been changed
        If Not Intersect(Target, Range("M26:M" & LastRow)) Is Nothing Then
           'Fills in input for each value
                For Each Target In Range("M26:M" & LastRow).Cells
    
                    Sheets("calc").Range("C7") = Target.Value
                    Sheets("calcb").Range("C7") = Target.Value
 'These next 4 lines are for the values in column H, which is 5 columns left of column M
                    Sheets("calc").Range("C9") = Target.Offset(0,-5).Value
                    Sheets("calc").Range("C20") = Target.Offset(0,-5).Value  
                    Sheets("calcb").Range("C9") = Target.Offset(0,-5).Value
                    Sheets("calcb").Range("C20") = Target.Offset(0,-5).Value            
               
                'Print values from calc sheet
     rij = Target.Row
                    Target.Offset(rij, 1) = Sheets!calc.[C36]
                    Target.Offset(rij, 2) = Sheets!calc.[U10]
                    Target.Offset(rij, 9) = Sheets!calcb.[C36]
                    Target.Offset(rij, 10) = Sheets!calcb.[U15]
              Next Target 
           End If
        
    End Sub
Let me know if my assumptions were correct.
Good luck!
Perpa
 
Upvote 0
Perpa,

Thank you so much for saving my hair! I would have NEVER found this on my own, I did not know about Target.Offset.VALUE but it sure will come in handy. And thank you for cleaning up the references for me. I was aware it is not the proper way to do it, but I just kept it that way under the motto 'if it aint broken dont fix it', and probably regret it inmediatly when I change the name of the sheet.

It turned into this:

Code:
  rij = Target.Row

When this was included, all my output had an extra row in between. Rij is row in Dutch by the way. I can't teach you VBA but atleast I can teach you Dutch? :LOL:

The 'rij' is a leftover from a different piece of code I use to do the calculations from a single given discharge, and then percentages in steps of 10% of it. It was used as the basis of this code to calculate this when discharge and head data are supplied. In this case I have for years of data and I can get a cup of coffee each time I press the 'calculate' button which starts the calculations.

However, removing the 'rij' from the Target.Offset(rij, X) lines causes the code to fail with a range error. When I put them back, it works fine.

Again, thank you so much for fixing my code!
 
Upvote 0

Forum statistics

Threads
1,214,653
Messages
6,120,751
Members
448,989
Latest member
mariah3

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