copy once to the last empty cell of a destination sheet

[erfo]

Hi; I do appreciate any help on the following vba macro problem:
I have
The source sheet has different data on A3, A4, A5; each data changes daily.
Destination sheet have D, G and J colums to be filled with the data from A3, A4 and A5 of the source sheet;
(E,F,H,I,J AND K have some calculations They are not my concern; they should not be touched).
when copies, it should copy to the last empty cell of the second sheet ONLY İF the source value is changed.
important NOTES: (a) I place/insert the vba code to the source sheet. (b) I use 3 if statements because I want each data copied individually (because I get some data in different hours of the day).
I have the following macro but it does not work as I want:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim wsSource As Worksheet, wsDestination As Worksheet
Dim NextRow As Long
Set wsSource = Sheets("g1")
Set wsDestination = Sheets("GLD")
If Target.Address = "$A$3" Then
NextRow = wsDestination.Cells(Rows.Count, "D").End(xlUp).Row + 1
wsDestination.Range("D" & NextRow).Value = Range("A3").Value
End If
If Target.Address = "$A$4" Then
NextRow = wsDestination.Cells(Rows.Count, "G").End(xlUp).Row + 1
wsDestination.Range("G" & NextRow).Value = Range("A4").Value
End If
If Target.Address = "$A$5" Then
NextRow = wsDestination.Cells(Rows.Count, "J").End(xlUp).Row + 1
wsDestination.Range("J" & NextRow).Value = Range("A5").Value
End If
End Sub

Here are the images of Sheet1 (g1) and Sheet2 (GLD):

Name	Nav
Dz Nav	0.152449
Gp Nav	9.883455
Pv Nav	35.0395

date	expl	expl	Dz Nav	ytd	daily %	Gp Nav	ytd	daily	Pv Nav	ytd	daily
			0.02405	7.34%	0.00%	9.40035	40.54%	0.00%	0.167906	29.23%	0.00%
			0.02435	8.72%	1.26%	9.40000	40.53%	0.00%	0.184345	41.88%	9.79%
			0.02314	3.28%	-5.27%	9.49791	42.00%	1.04%	0.184345	41.88%	0.00%
			0.02436	8.74%	5.02%	9.51419	42.24%	0.17%	0.184345	41.88%	0.00%
			0.02447	9.22%	0.45%	9.55992	42.92%	0.48%	0.188322	44.94%	2.16%

 

[MARK858]

Thanks a lot; your macro solved the problem of mutiple copying of the same value; BUT IT DOESNOT AUTOMATICALL COPY THE REFRESHED DATA TO THE DESTINATION; I HAVE TO ENTER THEM BY HAND (I have lots of them and takes very long time). I will need help on this. I do appreciate your help. best wishes,

It copies the cell every time there is a change made to one of B3, B4 or B5 unless they are changing by formula (which you haven't stated they are).
Please clarify exactly what you want by the term automatically

 

[erfo]

It copies the cell every time there is a change made to one of B3, B4 or B5 unless they are changing by formula (which you haven't stated they are).
Please clarify exactly what you want by the term automatically

Here is my detailed explanation: İn the present macro, there are data in the source sheet (wssource) to copy to the destination sheet (wsdestination)

In my excel sheets, (a) I donot type the data (values) in the wssource ; the data are uploaded from an external internet source by using excel query.

(b) Excel query refreshes the data in the source sheet whenever the data in the internet change.

(c) Namely, I do not type a new data in the source sheet; the data are downladed and refreshed via excel query.

The problem: The present macro does not copy the refreshed (updated) data to the destination sheet (wsdestination) .

Solution: The macro should be revised in such a way that it copies the data to the destination, each time the data are updated (refreshed) in the source. For instance, the macro should copy the value in the B3 to the destination, whenever it is updated.

Sorry for not being clear. Thanks again

 

[Bosquedeguate]

Try this code (for the Sheet where the values for both sheets g1 and GLD are entered).
In my test case updates to Sheet2!, Cells E1,F1 or G1 trigger the updating of GLD.

Input Sheet

CopyBalanceToCell.xlsm
	D	E	F	G	H
1		123	721	325
2
Sheet2

I assume Sheet g1 has its cell calculated like:

CopyBalanceToCell.xlsm
	A
2
3	123
4	721
5	325
6
g1

Cell Formulas
Range	Formula
A3	A3	=Sheet2!E1
A4	A4	=Sheet2!F1
A5	A5	=Sheet2!G1

and the destination sheet (where we conditionally add new rows), Sheet GLD is like:

CopyBalanceToCell.xlsm
	D	E	F	G	H	I	J
1
2	123			456			789
3	123			721			325
4
GLD

VBA code for Sheet2 (in my example)
Note: I added a message box for the times where values might be the same in one of the three columns
- OK response will add a new row
- Cancel - will do not and exit the Sub

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
  Dim wsDestination As Worksheet
  Dim wsSource As Worksheet
  Dim g1Rng As Range
  Dim NextRow As Long
  Dim idx As Integer
  Dim addrs, GLD_Cols, g1_addrs
  Dim col
  Dim resp As VbMsgBoxResult
  
  addrs = Array("$E$1", "$F$1", "$G$1") '
  g1_addrs = Array("$A$3", "$A$4", "$A$5")
  GLD_Cols = Array("D", "G", "J")
    
  On Error GoTo handle_err
  Set wsSource = Sheets("g1")
  Set wsDestination = Sheets("GLD")
  
  With WorksheetFunction
    idx = .Match(Target.Address, addrs, 0) - 1
    col = GLD_Cols(idx)
    Set g1Rng = wsSource.Range(g1_addrs(idx))
  End With
  With wsDestination
    NextRow = .Cells(Rows.Count, col).End(xlUp).Row + 1
    'if source value is the same as the value entered in the column
    If .Range(col & NextRow - 1).Value = g1Rng.Value Then
      resp = MsgBox("Current value of GLD!(" & col & (NextRow - 1) & "), " & g1Rng & ", is the same as sheet g1!(" & g1_addrs(idx) & ")." & vbCrLf & _
        "Do you want to create a new row on sheet GLD?", vbOKCancel)
      If resp = vbCancel Then Exit Sub
    End If
    .Range(col & NextRow).Value = g1Rng.Value
  End With
handle_err:  'jump here if Match or Index funtions fail
End Sub

 

[erfo]

Try this code (for the Sheet where the values for both sheets g1 and GLD are entered).
In my test case updates to Sheet2!, Cells E1,F1 or G1 trigger the updating of GLD.

Input Sheet

CopyBalanceToCell.xlsm
	D	E	F	G	H
1		123	721	325
2
Sheet2

I assume Sheet g1 has its cell calculated like:

CopyBalanceToCell.xlsm
	A
2
3	123
4	721
5	325
6
g1

Cell Formulas
Range	Formula
A3	A3	=Sheet2!E1
A4	A4	=Sheet2!F1
A5	A5	=Sheet2!G1

and the destination sheet (where we conditionally add new rows), Sheet GLD is like:

CopyBalanceToCell.xlsm
	D	E	F	G	H	I	J
1
2	123			456			789
3	123			721			325
4
GLD

VBA code for Sheet2 (in my example)
Note: I added a message box for the times where values might be the same in one of the three columns
- OK response will add a new row
- Cancel - will do not and exit the Sub

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
  Dim wsDestination As Worksheet
  Dim wsSource As Worksheet
  Dim g1Rng As Range
  Dim NextRow As Long
  Dim idx As Integer
  Dim addrs, GLD_Cols, g1_addrs
  Dim col
  Dim resp As VbMsgBoxResult
 
  addrs = Array("$E$1", "$F$1", "$G$1") '
  g1_addrs = Array("$A$3", "$A$4", "$A$5")
  GLD_Cols = Array("D", "G", "J")
   
  On Error GoTo handle_err
  Set wsSource = Sheets("g1")
  Set wsDestination = Sheets("GLD")
 
  With WorksheetFunction
    idx = .Match(Target.Address, addrs, 0) - 1
    col = GLD_Cols(idx)
    Set g1Rng = wsSource.Range(g1_addrs(idx))
  End With
  With wsDestination
    NextRow = .Cells(Rows.Count, col).End(xlUp).Row + 1
    'if source value is the same as the value entered in the column
    If .Range(col & NextRow - 1).Value = g1Rng.Value Then
      resp = MsgBox("Current value of GLD!(" & col & (NextRow - 1) & "), " & g1Rng & ", is the same as sheet g1!(" & g1_addrs(idx) & ")." & vbCrLf & _
        "Do you want to create a new row on sheet GLD?", vbOKCancel)
      If resp = vbCancel Then Exit Sub
    End If
    .Range(col & NextRow).Value = g1Rng.Value
  End With
handle_err:  'jump here if Match or Index funtions fail
End Sub

I am very sorry I confuse you by giving inconsistent details.
I have two sheets: g1 and GLD
Sheet g1 has source data (please see below):
Sheet g1: data source
View attachment 96799
Only the Nav values on g1 change daily and they are automaticaly updated.
The update is done via excel power query.
The macro sheet is placed in g1 sheet.

Second sheet is GLD.
The updated nav values (B3, B4, B5) on the g1 are copied to the last empty cells
on the GLD by using the macro.
Sheet GLD: copy destination sheet

The macro I need should copy ONLY THE NEW VALUES that are updated by the excel power query
on g1 to the last empty cells on GLD.
I hope this time I express myself clearly.
Thank you very much for your valuable help

 

[Bosquedeguate]

Something needs to trigger the update of your GLD sheet.
When your PowerQuery puts values into cells on sheet "g1" is that sheet active?
If not, is there an event that fires when PowerQuery updates that sheet? That is where your macro code needs to be placed.
I do not use PowerQuery.

 

[erfo]

Yes, it is active.
If I write a value to B3, B4 or B5, it copies them to the destination. If I refresh it, it refreshes the values (replaces the values I inserted), but it does not copy it to the destination. If I select the cell next to B3 and use autosum and copy it to the C3, it also copies to the destination. I hope these give you some clues. Thanks.

 

[Bosquedeguate]

OK try putting this code back onto Sheet "g1" and remove it from other sheets that you have.

I simulated PowerQuery by putting displaying a user form when Sheet g1 opens. It gives me the capability to write numbers to $A$3, $A$4, & A$5 on sheet g1.
when that sheet's cells are updated the Worksheet_Change function fires and conditionally posts values to Sheet GLD.

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
  Dim wsDestination As Worksheet
  Dim wsSource As Worksheet
  Dim g1Rng As Range
  Dim NextRow As Long
  Dim idx As Integer
  Dim GLD_Cols, g1_addrs
  Dim col
  Dim resp As VbMsgBoxResult
  
  g1_addrs = Array("$A$3", "$A$4", "$A$5")
  GLD_Cols = Array("D", "G", "J")
    
  On Error GoTo handle_err
  Set wsSource = Sheets("g1")
  Set wsDestination = Sheets("GLD")
  
  With WorksheetFunction
    idx = .Match(Target.Address, g1_addrs, 0) - 1
    col = GLD_Cols(idx)
    Set g1Rng = wsSource.Range(g1_addrs(idx))
  End With
  With wsDestination
    NextRow = .Cells(Rows.Count, col).End(xlUp).Row + 1
    'if source value is the same as the value entered in the column
    If .Range(col & NextRow - 1).Value = g1Rng.Value Then
      resp = MsgBox("Current value of GLD!(" & col & (NextRow - 1) & "), " & g1Rng & ", is the same as sheet g1!(" & g1_addrs(idx) & ")." & vbCrLf & _
        "Do you want to create a new row on sheet GLD?", vbOKCancel)
      If resp = vbCancel Then Exit Sub
    End If
    .Range(col & NextRow).Value = g1Rng.Value
  End With
handle_err:  'jump here if Match or Index funtions failEnd Sub
End Sub

 

[MARK858]

@erfo
Place the code below in your ThisWorkbook module. Change the table index to match your tables index.
Save, close and reopen the workbook, then test using RefreshAll

Private WithEvents QT As QueryTable

Private Sub Workbook_Open()
    Set QT = Sheets("g1").ListObjects(2).QueryTable 'CHANGE THE 2 TO MATCH YOUR TABLES INDEX
End Sub

Private Sub QT_AfterRefresh(ByVal Success As Boolean)
    If Success Then
        Dim wsSource As Worksheet, wsDestination As Worksheet
        Dim NextRow As Long
   
        Set wsSource = Sheets("g1")
        Set wsDestination = Sheets("GLD")
   

        NextRow = wsDestination.Cells(Rows.Count, "D").End(xlUp).Row
        If wsDestination.Range("D" & NextRow).Value <> wsSource.Range("B3").Value Then wsDestination.Range("D" & NextRow + 1).Value = wsSource.Range("B3").Value
 
   

        NextRow = wsDestination.Cells(Rows.Count, "G").End(xlUp).Row
        If wsDestination.Range("G" & NextRow).Value <> wsSource.Range("B4").Value Then wsDestination.Range("G" & NextRow + 1).Value = wsSource.Range("B4").Value
 
   
   
        NextRow = wsDestination.Cells(Rows.Count, "J").End(xlUp).Row
        If wsDestination.Range("J" & NextRow).Value <> wsSource.Range("B5").Value Then wsDestination.Range("J" & NextRow + 1).Value = wsSource.Range("B5").Value
    End If
End Sub

 

[erfo]

OK try putting this code back onto Sheet "g1" and remove it from other sheets that you have.

I simulated PowerQuery by putting displaying a user form when Sheet g1 opens. It gives me the capability to write numbers to $A$3, $A$4, & A$5 on sheet g1.
when that sheet's cells are updated the Worksheet_Change function fires and conditionally posts values to Sheet GLD.

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
  Dim wsDestination As Worksheet
  Dim wsSource As Worksheet
  Dim g1Rng As Range
  Dim NextRow As Long
  Dim idx As Integer
  Dim GLD_Cols, g1_addrs
  Dim col
  Dim resp As VbMsgBoxResult
 
  g1_addrs = Array("$A$3", "$A$4", "$A$5")
  GLD_Cols = Array("D", "G", "J")
   
  On Error GoTo handle_err
  Set wsSource = Sheets("g1")
  Set wsDestination = Sheets("GLD")
 
  With WorksheetFunction
    idx = .Match(Target.Address, g1_addrs, 0) - 1
    col = GLD_Cols(idx)
    Set g1Rng = wsSource.Range(g1_addrs(idx))
  End With
  With wsDestination
    NextRow = .Cells(Rows.Count, col).End(xlUp).Row + 1
    'if source value is the same as the value entered in the column
    If .Range(col & NextRow - 1).Value = g1Rng.Value Then
      resp = MsgBox("Current value of GLD!(" & col & (NextRow - 1) & "), " & g1Rng & ", is the same as sheet g1!(" & g1_addrs(idx) & ")." & vbCrLf & _
        "Do you want to create a new row on sheet GLD?", vbOKCancel)
      If resp = vbCancel Then Exit Sub
    End If
    .Range(col & NextRow).Value = g1Rng.Value
  End With
handle_err:  'jump here if Match or Index funtions failEnd Sub
End Sub

Unfortunately it does not work. Firstly, I typed new data on A3, A4 and A5; It copied to the GLD. very good. Secondly, I refreshed the data on A3, A4 and A5 by using powerquery (later, a vba macro); refreshing was succesfull. But the "Private Sub Worksheet_Change(ByVal Target As Range)" macro did not pick up the change and did not do any changes. I am extremelt frustrated, becuase it is more than a month I spends at least 10 hours a day to solve it. I do really appreciate your effort to solve it.

 

[erfo]

@erfo
Place the code below in your ThisWorkbook module. Change the table index to match your tables index.
Save, close and reopen the workbook, then test using RefreshAll

Private WithEvents QT As QueryTable

Private Sub Workbook_Open()
    Set QT = Sheets("g1").ListObjects(2).QueryTable 'CHANGE THE 2 TO MATCH YOUR TABLES INDEX
End Sub

Private Sub QT_AfterRefresh(ByVal Success As Boolean)
    If Success Then
        Dim wsSource As Worksheet, wsDestination As Worksheet
        Dim NextRow As Long
  
        Set wsSource = Sheets("g1")
        Set wsDestination = Sheets("GLD")
  

        NextRow = wsDestination.Cells(Rows.Count, "D").End(xlUp).Row
        If wsDestination.Range("D" & NextRow).Value <> wsSource.Range("B3").Value Then wsDestination.Range("D" & NextRow + 1).Value = wsSource.Range("B3").Value
 
  

        NextRow = wsDestination.Cells(Rows.Count, "G").End(xlUp).Row
        If wsDestination.Range("G" & NextRow).Value <> wsSource.Range("B4").Value Then wsDestination.Range("G" & NextRow + 1).Value = wsSource.Range("B4").Value
 
  
  
        NextRow = wsDestination.Cells(Rows.Count, "J").End(xlUp).Row
        If wsDestination.Range("J" & NextRow).Value <> wsSource.Range("B5").Value Then wsDestination.Range("J" & NextRow + 1).Value = wsSource.Range("B5").Value
    End If
End Sub

Thanks a lot for revisions. I tried it, but it completely stopped; Firstly, I run it as is, it didnot do anything. (2) Secondly, I employed "refresh all", it refreshed the data on the g1; but nothing on the GLD. Thirdly, ı tried after removing "Private Sub Workbook_Open()"; nothing happenned; ı typed the data by hand; no success; Fourthly, I tried your previous macro, it worked when i typed the data; but didnot copied to the GLD, fter refreshing the data by using a diffrerent vba macro. I have being using many combinations and other solutions with no success. I am frustrated becuase I spend a lot of time, over a month to solve it. I hope we solve it eventually. Thanks a lot for your kind interest and effort to help.