copying daily changing values from a sheet to another using vba

[erfo]

Hi; I have source data in a worksheet that changes daily; I have destination worksheet wherein I copy data from the source automatically to the last empty cells. My problem is this: It copies/adds the already copied values to the next empty cell when the unchanged data is refreshed (before the source value changes). Following is the vba code I use and I think it is not a porper one. . Thank you for your help.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim wsMain As Worksheet, wsHistory As Worksheet
Dim NextRow As Long
Set wsMain = Sheets("g1")
Set wsHistory = Sheets("GLD")
If Target.Address = "$E$1" Then
NextRow = wsHistory.Cells(Rows.Count, "E").End(xlUp).Row + 1
Range("E" & NextRow).Value = Range("E1").Value
Range("H" & NextRow).Value = Range("H1").Value
Range("K" & NextRow).Value = Range("K1").Value
Range("N" & NextRow).Value = Range("N1").Value
Range("Q" & NextRow).Value = Range("Q1").Value
Range("T" & NextRow).Value = Range("T1").Value
End If
End Sub

 

[Bosquedeguate]

Private Sub Worksheet_Change(ByVal Target As Range)
  Dim wsMain As Worksheet, wsHistory As Worksheet
  Dim NextRow As Long
  Set wsMain = Sheets("g1")
  Set wsHistory = Sheets("GLD")
  If Target.Address = "$E$1" Then
    NextRow = wsHistory.Cells(Rows.Count, "E").End(xlUp).Row + 1
    Range("E" & NextRow).Value = Range("E1").Value
    Range("H" & NextRow).Value = Range("H1").Value
    Range("K" & NextRow).Value = Range("K1").Value
    Range("N" & NextRow).Value = Range("N1").Value
    Range("Q" & NextRow).Value = Range("Q1").Value
    Range("T" & NextRow).Value = Range("T1").Value
  End If
End Sub

You have this code at the Workbook level. It is triggered whenever you change the active worksheet.

You defined and set wsMain to Sheets("g1")
and wsHistory = Sheets("GLD")

but you do not use these variables in your code.

What your code does

• It is triggered whenever there is a change on the worksheet (I assume to have this event code tied to sheet "g1")
• It then tests for change of cell "E1" on that sheet (this may not be exactly what you want) You would have make sure that Cell E1 is the last cell value you change; i.e.
  cells H, K, N, Q, T would need to change prior to changing the value of Cell E1.
  (I would think you would want to be able to change any or all of these values in any order that you want and then when you are ready trigger the copy of the data to you GLD sheet - maybe via a button on the form?)
• Finds the next available row number from wsHistory (i.e. worksheet GLD)
• then code just copies values from Row 1, Columns E, H, K, N, Q T to the row defined by NextRow, but the on the same sheet you are copying cells from

Assuming that Sheet("g1") is your source data and Sheet("GLD") is where you want the data copied to your code should be something like the following:
Try this code:

Private Sub Worksheet_Change(ByVal Target As Range)
  Dim wsHistory As Worksheet
  Dim rngMain As Range, rngHistory As Range
  Dim NextRow As Long
  Dim c As Long
  
  Set wsHistory = Sheets("GLD")
  Set rngMain = Sheets("g1").Range("E1,H1,K1,N1,Q1,T1")
  Set rngHistory = wsHistory.Range("E1,H1,K1,N1,Q1,T1")
  If Target.Address = "$E$1" Then
    NextRow = wsHistory.Cells(Rows.Count, "E").End(xlUp).Row + 1
    For c = 1 To rngMain.Cells.Count
      rngHistory(1, c) = rngMain(1, c)  'copy from sheet "g1" to sheet "GLD"
    Next c
  End If
End Sub

 

[erfo]

Thanks Bosquedeguate for your help and suggestions. Unfortunately, your suggestions did not solve my problem because it is my fault; I made a mistake and pasted wrong information (wrong vba macro). I am rewriting everything so that I can get right help.
Thanks a lot for your help again. I am sorry but I gave incorrect info.
Here is the correct oen:
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 source sheet;
E,F,H,I,J AND K have some calculations (They are not our concern; they should not be touched).
The code I use copies the data to the last empty cells, so there is no problem.
The problem starts when data is refreshed during the same day: It is not supposed to write the same day's data to the next cell; it is supposed to do nothing because values on the source are not changed (same as the last cells).
Thus, my vba codes should be revised in such a way that it will not do anything unless the source data changes (namely, it does not write to the last empty cell if source data and last populated cells are same).
important NOTES: (a) I place/insert the vba code to the source sheet. (b) I used 3 if statements because I want each data copied individually (because I get some data in different hours of the day).

My vba code is as below:
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

 

[Bosquedeguate]

Try is Worksheet_Change Sub. Does it do what you need?
The reason for the question is this; if for example $A$3 has a value of 123 (assuming $A$4 and $A$5 do not have values)
1st time 123 should be written to Dnextrow on the "GLD"
if you re-enter 123 in cell $A$3 on the "g1" this Sub will not write to sheet "GLD". Same for $A$4 and $A$5

what should happen if you clear $A$3 at this point? the way the code currently works is 123 would remain in Column D on "GLD" because
a cleared (or zero) cell value is not equal to 123.

It think bit more clarification of your logic is needed.

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
  Dim wsDestination As Worksheet
  Dim NextRow As Long
  Dim idx As Integer
  Dim addrs, outputs
  Dim col
  addrs = Array("$A$3", "$A$4", "$A$5")
  outputs = Array("D", "G", "J")
  
  Set wsDestination = Sheets("GLD")
  With WorksheetFunction
    'look for an address match in the acceptable range (defined by addrs array)
    idx = IIf(.IsNA(.Match(Target.Address, addrs, 0)), 0, .Match(Target.Address, addrs, 0))
    If idx = 0 Then Exit Sub 'itarget.address in not in acceptable range exit
    'get the destination column for the source address
    col = .Index(outputs, idx)
  End With
  With wsDestination
    'calculate the next row
    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 = Target.Value Then Exit Sub
    .Range(col & NextRow).Value = Target.Value
  End With
End Sub

 

[erfo]

Try is Worksheet_Change Sub. Does it do what you need?
The reason for the question is this; if for example $A$3 has a value of 123 (assuming $A$4 and $A$5 do not have values)
1st time 123 should be written to Dnextrow on the "GLD"
if you re-enter 123 in cell $A$3 on the "g1" this Sub will not write to sheet "GLD". Same for $A$4 and $A$5

what should happen if you clear $A$3 at this point? the way the code currently works is 123 would remain in Column D on "GLD" because
a cleared (or zero) cell value is not equal to 123.

It think bit more clarification of your logic is needed.

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
  Dim wsDestination As Worksheet
  Dim NextRow As Long
  Dim idx As Integer
  Dim addrs, outputs
  Dim col
  addrs = Array("$A$3", "$A$4", "$A$5")
  outputs = Array("D", "G", "J")
 
  Set wsDestination = Sheets("GLD")
  With WorksheetFunction
    'look for an address match in the acceptable range (defined by addrs array)
    idx = IIf(.IsNA(.Match(Target.Address, addrs, 0)), 0, .Match(Target.Address, addrs, 0))
    If idx = 0 Then Exit Sub 'itarget.address in not in acceptable range exit
    'get the destination column for the source address
    col = .Index(outputs, idx)
  End With
  With wsDestination
    'calculate the next row
    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 = Target.Value Then Exit Sub
    .Range(col & NextRow).Value = Target.Value
  End With
End Sub

Thanks a lot for your help. You wrote an excellent macro. It is short and fast, with sometimes annoying, but useful error message box.
First I like to answer your questions:
(a) Cell values fo A3, A4 and A5 on Sheet g1 are automatically updated by the excel query, so they change every day in different times.
(b) Becuase each one of them are updated in different times, I wanted the way you did it in your macro: It copies the value to the destination cells, whenever change occurs; (c) Also, I didnot want the macro copy the same value more than ones to the last empty cell on the destination sheet (values are hardly ever same in consequative days), when the excel query refreshes with no change in value. Your present macro solved this problem, too. However, the major problem that I couldnot explain clearly before still remains unsolved.

HERE IS A DETAILED EXPLANATION OF THE MACRO PROBLEM THAT NEEDS SOLUTION:
I place the macro in sheet1 (not in thisworkbook or another place) (Is it ok?)
All my data are numbers with varying decimals.
Sheet1 has my data. It has two columns: Name (A column) and Decimal Number (B column). (I previously wrote wrong as A3, A4 and A5).
Sheet1 data values are updated by excel workboook query automatically.
But, your macro gives the following message when I try to refresh the excel workbook query:
"unable to get match property of the WorksheetFunction Class".
However, it completes updating the data in the sheet1, when I press "end" selection in the message box.
Namely, the excel query-update places the old values with new ones on the Sheet1.
REGARDING THE PRESENT MACRO: The present macro does not copy the updated data values in the sheet1
to the destination sheet unless I write them by hand (I have many sheets of different data). So, the macro needs revision so that it copies the new values on the source cells to the destination cells (without entering by hand).
Thank you for your help again.

 

[Fluff]

Duplicate to: copy once to the last empty cell of a destination sheet

In future, please do not post the same question multiple times. Per Forum Rules (#12), posts of a duplicate nature will be locked or deleted.

In relation to your question here, I have closed this thread so please continue in the linked thread.