copy once to the last empty cell of a destination sheet

E

erfo

New Member
Joined
Aug 5, 2023
Messages
22
Office Version
  1. 2016
Platform
  1. Windows
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 Nav0.152449
Gp Nav9.883455
Pv Nav35.0395



dateexplexplDz Navytd daily %Gp NavytddailyPv Nav ytddaily
0.024057.34%0.00%9.4003540.54%0.00%0.16790629.23%0.00%
0.024358.72%1.26%9.4000040.53%0.00%0.18434541.88%9.79%
0.023143.28%-5.27%9.4979142.00%1.04%0.18434541.88%0.00%
0.024368.74%5.02%9.5141942.24%0.17%0.18434541.88%0.00%
0.024479.22%0.45%9.5599242.92%0.48%0.18832244.94%2.16%
 

Excel Facts

Which came first: VisiCalc or Lotus 1-2-3?
Dan Bricklin and Bob Frankston debuted VisiCalc in 1979 as a Visible Calculator. Lotus 1-2-3 debuted in the early 1980's, from Mitch Kapor.
Sort by date Sort by votes
Looking at your first image are you sure that the cells that you are changing/transferring are A3,A4 and A5? it looks more like B3,B4 and B5 that you want transferred over?

On the above please see the posting notes below

When using XL2BB please use the Mini Sheet option rather than the Table option by default, then you will get the Row and Column labels and the sheet name displayed (and any formulas, named ranges or Conditional formatting details depending on the option buttons selected) i.e. with your 2nd table you will get

Book1
ABCDEFGHIJKL
1dateexplexplDz Navytd daily %Gp NavytddailyPv Nav ytddaily
20.0240460.07343409.4003480.40538600.1679060.292280
30.0243540.0871840.0126479.40.405334-3.7E-050.1843450.4188020.097906
40.0231350.032766-0.052699.4979130.4199730.0104160.1843450.4188020
50.0243580.0873620.0502099.5141920.4224060.0017140.1843450.4188020
60.0244670.0922280.0044559.5599170.4292420.0048060.1883220.4494110.021574
GLD
Cell Formulas
RangeFormula
E2:E6E2=SUM(D2-0.022401)/0.022401
H2:H6H2=IF(G2=0,"",(G2-6.6888)/6.6888)
K2:K6K2=IF(J2=0,"",(J2-0.12993)/(0.12993))
F3:F6F3=SUM(D3-D2)/D3
I3:I6,L3:L6I3=IF(G3=0,"",(G3-G2)/G2)


When posting code please use code tags (copy and paste your code in the thread, select the code and then click one of the code icons at the top of the posting window). Then it will retain it's formatting and give a button we can use to copy the code code in one go.
1691378978046.png

With your original code it will look like the code below with the VBA icon

VBA Code: 
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
 
Upvote 0
Thank you for your reminders and warnings.
You are right it is supposed to be B3, B4 and B5.
I just strarted using you yor board, that's I donot know how to revise my post.
I used the table, because I donot have any formula in the destination cells where the data copied.
Thanks
 
Upvote 0
erfo said:
I used the table, because I donot have any formula in the destination cells where the data copied.
Click to expand...
Don't worry if there are no formula there or not, it is best to stick with the Mini sheet option by default (it's ok, we can see that you are a new member and so it'll take a while getting familiar with the tools)

So changing your code to

VBA Code: 
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 = "$B$3" Then
        NextRow = wsDestination.Cells(Rows.Count, "D").End(xlUp).Row + 1
        wsDestination.Range("D" & NextRow).Value = Range("B3").Value
    End If
    If Target.Address = "$B$4" Then
        NextRow = wsDestination.Cells(Rows.Count, "G").End(xlUp).Row + 1
        wsDestination.Range("G" & NextRow).Value = Range("B4").Value
    End If
    If Target.Address = "$B$5" Then
        NextRow = wsDestination.Cells(Rows.Count, "J").End(xlUp).Row + 1
        wsDestination.Range("J" & NextRow).Value = Range("B5").Value
    End If
End Sub
What issues do you get? if I change B3 to 0.152448 I get...

Book1
ABCDEFGHIJKL
1dateexplexplDz Navytd daily %Gp NavytddailyPv Nav ytddaily
20.0240460.07343409.4003480.40538600.1679060.292280
30.0243540.0871840.0126479.40.405334-3.7E-050.1843450.4188020.097906
40.0231350.032766-0.052699.4979130.4199730.0104160.1843450.4188020
50.0243580.0873620.0502099.5141920.4224060.0017140.1843450.4188020
60.0244670.0922280.0044559.5599170.4292420.0048060.1883220.4494110.021574
70.152448
GLD
 
Upvote 0
MARK858 said:
Looking at your first image are you sure that the cells that you are changing/transferring are A3,A4 and A5? it looks more like B3,B4 and B5 that you want transferred over?

On the above please see the posting notes below

When using XL2BB please use the Mini Sheet option rather than the Table option by default, then you will get the Row and Column labels and the sheet name displayed (and any formulas, named ranges or Conditional formatting details depending on the option buttons selected) i.e. with your 2nd table you will get

Book1
ABCDEFGHIJKL
1dateexplexplDz Navytd daily %Gp NavytddailyPv Nav ytddaily
20.0240460.07343409.4003480.40538600.1679060.292280
30.0243540.0871840.0126479.40.405334-3.7E-050.1843450.4188020.097906
40.0231350.032766-0.052699.4979130.4199730.0104160.1843450.4188020
50.0243580.0873620.0502099.5141920.4224060.0017140.1843450.4188020
60.0244670.0922280.0044559.5599170.4292420.0048060.1883220.4494110.021574
GLD
Cell Formulas
RangeFormula
E2:E6E2=SUM(D2-0.022401)/0.022401
H2:H6H2=IF(G2=0,"",(G2-6.6888)/6.6888)
K2:K6K2=IF(J2=0,"",(J2-0.12993)/(0.12993))
F3:F6F3=SUM(D3-D2)/D3
I3:I6,L3:L6I3=IF(G3=0,"",(G3-G2)/G2)


When posting code please use code tags (copy and paste your code in the thread, select the code and then click one of the code icons at the top of the posting window). Then it will retain it's formatting and give a button we can use to copy the code code in one go.
View attachment 96667
With your original code it will look like the code below with the VBA icon

VBA Code: 
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
Click to expand...
B3, B4 and B5 are source datain the sheet1 (g1); their values change daily. They are copied automatically to the destination cells in the sheet2 (GLD) by the vba macro each time they change.
thanks
 
Upvote 0
erfo said:
B3, B4 and B5 are source datain the sheet1 (g1); their values change daily. They are copied automatically to the destination cells in the sheet2 (GLD) by the vba macro each time they change.
thanks
Click to expand...
With the last macro that I posted does it not do that?
 
Upvote 0
Macro I use that needs corrections/additions:

VBA Code: 
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 = "$B$3" Then
NextRow = wsDestination.Cells(Rows.Count, "D").End(xlUp).Row + 1
wsDestination.Range("D" & NextRow).Value = Range("B3").Value
End If
If Target.Address = "$B$4" Then
NextRow = wsDestination.Cells(Rows.Count, "G").End(xlUp).Row + 1
wsDestination.Range("G" & NextRow).Value = Range("B4").Value
End If
If Target.Address = "$B$5" Then
NextRow = wsDestination.Cells(Rows.Count, "J").End(xlUp).Row + 1
wsDestination.Range("J" & NextRow).Value = Range("B5").Value
End If
End Sub
 
Upvote 0
MARK858 said:
With the last macro that I posted does it not do that?
Click to expand...
MARK858 said:
With the last macro that I posted does it not do that?
Click to expand...
I am sorry I guess I could not state the main problem clearly: I have exactly the same macro you posted; it works. Problem is different. Let me explain the problem: Let's say I have new data on B3=0.3 (Sheet1) at 1 pm. It copies B3 value to the last empty cell of second sheet. So, no problem because that what I want. Here is the problem: It copies the same value to the next empty cell, when the macro is refreshed before the B3 value changed during the same day (namely, B3 value was 0.3; refreshed value is also 0.3); it is not supposed to copy it; but it copes it to the next empty cell. It should compare the B3, B4 and B5 with the last copied cells values at the destination, and if, for instance, B3 = "wsDestination.Cells(Rows.Count, "D").End(xlUp).Row") then it should do nothing. If not equal then it should copy B3 to "wsDestination.Cells(Rows.Count, "D").End(xlUp).Row +1" (to the last empty cell).
Thanks a lot for your patience and help.
 
Upvote 0
Maybe....

VBA Code: 
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")
    
    Application.EnableEvents = False
    
    If Target.Address = "$B$3" Then
        NextRow = wsDestination.Cells(Rows.Count, "D").End(xlUp).Row
        If wsDestination.Range("D" & NextRow).Value <> Target.Value Then wsDestination.Range("D" & NextRow + 1).Value = Target.Value
    End If
    
    If Target.Address = "$B$4" Then
        NextRow = wsDestination.Cells(Rows.Count, "G").End(xlUp).Row
        If wsDestination.Range("G" & NextRow).Value <> Target.Value Then wsDestination.Range("G" & NextRow + 1).Value = Target.Value
    End If
    
    If Target.Address = "$B$5" Then
        NextRow = wsDestination.Cells(Rows.Count, "J").End(xlUp).Row
        If wsDestination.Range("J" & NextRow).Value <> Target.Value Then wsDestination.Range("J" & NextRow + 1).Value = Target.Value
    End If
    
    Application.EnableEvents = True
    
End Sub
 
Last edited:
Upvote 0
MARK858 said:
Maybe....

VBA Code: 
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")
   
    Application.EnableEvents = False
   
    If Target.Address = "$B$3" Then
        NextRow = wsDestination.Cells(Rows.Count, "D").End(xlUp).Row
        If wsDestination.Range("D" & NextRow).Value <> Target.Value Then wsDestination.Range("D" & NextRow + 1).Value = Target.Value
    End If
   
    If Target.Address = "$B$4" Then
        NextRow = wsDestination.Cells(Rows.Count, "G").End(xlUp).Row
        If wsDestination.Range("G" & NextRow).Value <> Target.Value Then wsDestination.Range("G" & NextRow + 1).Value = Target.Value
    End If
   
    If Target.Address = "$B$5" Then
        NextRow = wsDestination.Cells(Rows.Count, "J").End(xlUp).Row
        If wsDestination.Range("J" & NextRow).Value <> Target.Value Then wsDestination.Range("J" & NextRow + 1).Value = Target.Value
    End If
   
    Application.EnableEvents = True
   
End Sub
Click to expand...
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,
 
Upvote 0
You must log in or register to reply here.

Similar threads

J
  • Question Question
Code Issue
Replies
1
Views
175
RoryA
RoryA
R
  • Question Question
VBA- Adding source and destination cells together rather than overwriting
Replies
4
Views
246
Alex Blakenburg
A
A
  • Solved
Extract and Merge Files
Replies
1
Views
75
rowebca
rowebca
C
  • Question Question
Move Completed cells auto using VBA when they have been changed to completed
Replies
5
Views
360
dmt32
D
P
  • Solved
VBA Code to move entire row of data based on multiple number criteria
2 3 4
Replies
31
Views
841
mumps
mumps

Forum statistics

Threads
1,223,227
Messages
6,170,848
Members
452,361
Latest member
d3ad3y3

Share this page

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