Specify conditions in one sheet to fill another sheet

G

gubertu

New member
Joined
May 24, 2015
Messages
14
Reaction score
0
Points
0
I would like to do the following:
I have 3 sheets:
1. Data
2. Sheet A
3. Sheet B

What I want is, in Sheet 'Data', specify the name of the sheet and the cell where I want to go a value, and automatically the value goes to that Sheet and Cell, without formuling the destination sheet.

For example:
1. In sheet 'Data' I have the Columns:
- Sheet = I give the value 'Sheet A'
- Cell = I give the value 'B3'
- Value = 10.000

2. I want that after filling this form, the value 10.000 goes to Cell B3 in Sheet A.

Appreciate your help.

Wish I could have explained well.

Thanks!
 
Right click the sheet's tab, View Code, and paste this.
When the value is changed in column 3, it gets the worksheet name from column 1 and the cell name from column 2 and if that exists, it puts the value accordingly. Either can be done in code.

I don't know what formulating means. 10.000 will not be the same format on the cell that you designate unless the format is added as well or the cell is copied.

Code: 
Private Sub Worksheet_Change(ByVal Target As Range)  Dim r As Range
  If Target.Column <> 3 Or Target.Cells.Count <> 1 Then Exit Sub
  With Target
    Set r = Worksheets(.Offset(, -2).Value).Range(.Offset(, -1).Value)
    If r Is Nothing Then Exit Sub
    r.Value = .Value
  End With
End Sub
 
Hi Kenneth and thanks for reply. I am afraid I did not explain myself... I have attached an Excel file where with my explanation on what I want to do. I trust this will clarify you. Thanks a lot for your help!
 

Attachments

  • Example.xlsx
    15.5 KB · Views: 22
My code does exactly what you asked? Did you even try it?

In the column with the values to transfer, press F2 to edit it and change the value or Enter to transfer the current value.
 
try:
Code: 
Sub blah()
For Each cll In Sheets("Data").Range("A2:A50").Cells 'adjust range to suit.
If Len(cll.Value) > 0 And Len(cll.Offset(, 1).Value) > 0 Then Sheets(cll.Value).Range(cll.Offset(, 1).Value) = cll.Offset(, 2).Value
Next cll
End Sub
 
Thanks Kenneth and p45cal for your help.

Probably both codes do the same but which is more closer to that I want is the one proposed by p45cal (I´m new with VBA and the one and Kenneth´s code does not work for me, probably because I am not copying it properly).

As I can see from the code proposed by p45cal, is there are more than one amount with the same "Destination cell" (in my example, there are two amounts with destination cell "D5"), it only brings to tab "BS" one amount (in this case, 200, instead of 1.200 (1.000 + 200).

Maybe the code is mising something but I do not know how to correct it.

Appreciate your help.

Thanks in advance!
 
Summing was not mentioned in your first post. Did you want to sum only those from the Data sheet and then add it or sum those and add to the value that might already exist?
 
You are right Kenneth I forgot to mention it. I want to sum only those from the data sheet. Would it be possible?
Thanks!
 
Now I understood Kenneth code. It is amazing how it works without running a macro!

I just need to sum all the value with same "Destination Cell" and it would be perfect. It is possible?

Also, I would to ask Kenneth how can I convert your code for run it by a macro.

Thanks in advance!
 
Normally, one might use a filter to do this or maybe an =SumProduct() method.

I did all but one part. You can either write another Sub to update for all Data!C values, or use the Worksheet event method and pass Target as the range to the PutOff2RSum() routine.

These would be in a Module.
Code: 
Sub Test_Off2Rsum()  
  MsgBox Off2RSum(Worksheets("Data").Range("C3"))
End Sub


Sub Test2_Off2Rsum()
  Dim c As Range
  For Each c In Worksheets("Data").Range("C2", Worksheets("Data").Range("C" & Rows.Count).End(xlUp))
    MsgBox c.Address & ": " & CStr(Off2RSum(c))
  Next c
End Sub


Sub Test_PutOff2Sum()
  PutOff2RSum Worksheets("Data").Range("C3")
End Sub


Sub PutOff2RSum(aRange As Range)
  With aRange
    Worksheets(.Offset(, -2).Value2).Range(.Offset(, -1).Value2) = Off2RSum(aRange)
  End With
End Sub


Function Off2RSum(aRange As Range) As Double
  Dim c As Range, ws As Worksheet, d As Double
  Set ws = Worksheets(aRange.Parent.Name)
  For Each c In ws.Range(ws.Cells(2, aRange.Column), ws.Cells(Rows.Count, aRange.Column).End(xlUp))
    With aRange
      If c.Offset(, -1).Value2 = .Offset(, -1).Value2 And _
        c.Offset(, -2).Value2 = .Offset(, -2).Value2 Then _
        d = d + c.Value
    End With
  Next c
  Off2RSum = d
End Function
 
Last edited:
I am afraid that code is not working for me.

Would it be possible to modify this code for adding all the values under same "Destination cell"?

Thanks!


Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
Dim r As Range
If Target.Column <> 3 Or Target.Cells.Count <> 1 Then Exit Sub
With Target
  Set r = Worksheets(.Offset(, -2).Value).Range(.Offset(, -1).Value)
  If r Is Nothing Then Exit Sub
  r.Value = .Value
End With
End Sub
 
Last edited by a moderator:
Paste code between code tags. You can easily insert them by typing them or clicking the Go Advanced button in lower right of a reply, and then click the # icon.

I guess you would use Offset() if you want to put a value below a Destination cell.

From my posts 2 and 10, the solution using the Change event would be:
Code: 
Private Sub Worksheet_Change(ByVal Target As Range)  
  Dim r As Range
  If Target.Column <> 3 Or Target.Cells.Count <> 1 Then Exit Sub
  With Target
    Set r = Worksheets(.Offset(, -2).Value).Range(.Offset(, -1).Value)
    If r Is Nothing Then Exit Sub
    PutOff2RSum Target
  End With
End Sub




'Put the two routines below in a Module or ok if left in the sheet's code if only used for that sheet.


Sub PutOff2RSum(aRange As Range)
  With aRange
    Worksheets(.Offset(, -2).Value2).Range(.Offset(, -1).Value2) = Off2RSum(aRange)
  End With
End Sub




Function Off2RSum(aRange As Range) As Double
  Dim c As Range, ws As Worksheet, d As Double
  Set ws = Worksheets(aRange.Parent.Name)
  For Each c In ws.Range(ws.Cells(2, aRange.Column), ws.Cells(Rows.Count, aRange.Column).End(xlUp))
    With aRange
      If c.Offset(, -1).Value2 = .Offset(, -1).Value2 And _
        c.Offset(, -2).Value2 = .Offset(, -2).Value2 Then _
        d = d + c.Value
    End With
  Next c
  Off2RSum = d
End Function
 
This is working now!! Thanks very much for your help Kenneth you taught me a lot!

Thanks :)
 
By the way,

The code works perfect, but I would like to know if there´s a possibility to delete the values that are placed in sheet "BS", when I delete the values in column "C" of sheet "Data".

Because the linked values still continue in sheet "BS".

Thanks!
 
An empty value summed, is 0. You can set your Options to not display values of 0.

Of course you could add an If() and if the sum was 0 then put the value as "".
e.g.
Code: 
Private Sub Worksheet_Change(ByVal Target As Range)  
  Dim r As Range
  If Target.Column <> 3 Or Target.Cells.Count <> 1 Then Exit Sub
  With Target
    Set r = Worksheets(.Offset(, -2).Value).Range(.Offset(, -1).Value)
    If r Is Nothing Then Exit Sub
    If Off2RSum(Target) = 0 Then
        Worksheets(.Offset(, -2).Value2).Range(.Offset(, -1).Value2).Value2 = ""
        Else
        PutOff2RSum Target
    End If
  End With
End Sub
 
Last edited:
Kenneth,

I attach the Excel file with all the codes included.

If I delete the values from "Data", column C (all the values at once), these are not also deleted from sheet "BS", cells D5 and D6. They remain.

If I delete the values from "Data", column C, one by one, they are perfectly deleted in sheet "BS".

What I want is when I delete the values in sheet "Data" at once, they are deleted from sheet "BS" as well.

Would it be possible?

Thanks!
 

Attachments

  • Example.xlsm
    20.8 KB · Views: 6
Sure. I added just a bit more too.
Code: 
Private Sub Worksheet_Change(ByVal Target As Range)  
 Dim r As Range, c As Range
  If Target.Column <> 3 or Target.Columns.Count <>1 Then Exit Sub
  
   On Error GoTo EndNow
  Application.EnableEvents = False
  Application.ScreenUpdating = False
  
  For Each c In Target
    With c
      Set r = Worksheets(.Offset(, -2).Value).Range(.Offset(, -1).Value)
      If r Is Nothing Then Exit Sub
      If Off2RSum(c) = 0 Then
          Worksheets(.Offset(, -2).Value2).Range(.Offset(, -1).Value2).Value2 = ""
          Else
          PutOff2RSum c
      End If
    End With
  Next c
  
EndNow:
  Application.EnableEvents = True
  Application.ScreenUpdating = True
End Sub
 
Thank you very much Kenneth.

That work perfect!! Thanks a lot again :)
 
You must log in or register to reply here.
Back
Top