PDA

View Full Version : VBA Code To Move Data From One Sheet To Another And Delete From Source Sheet


rich_cirillo
06-20-2013, 11:22 AM
Hi

I require a macro to enter data..I enter data into Sheet 1 for each day.When i have all 5 days of data filled i press a button (macro) and it inserts the data into Sheet 2 matching the dates in Sheet 2 (sheet 1 and Sheet 2 dates must be an exact match to enter).....it enters the names,numbers and average,,,,i also need a button to delete the names,numbers and average from sheet 1 once entered in Sheet 2.....is it possible that the data cannot be deleted from Sheet 1 unless it has been entered in Sheet 2....

Thanks

Rich



https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA (https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA)
https://www.youtube.com/watch?v=f7xZivqLZxc&lc=Ugxq4JHRza_zx3sz0fx4AaABAg (https://www.youtube.com/watch?v=f7xZivqLZxc&lc=Ugxq4JHRza_zx3sz0fx4AaABAg)
https://www.youtube.com/watch?v=f7xZivqLZxc&lc=UgzMCQUIQgrbec400jl4AaABAg (https://www.youtube.com/watch?v=f7xZivqLZxc&lc=UgzMCQUIQgrbec400jl4AaABAg)
https://www.youtube.com/watch?v=f7xZivqLZxc&lc=UgwhVTFaD469mW9wO194AaABAg.9gJzxwFcnPU9gORqKw5t W_ (https://www.youtube.com/watch?v=f7xZivqLZxc&lc=UgwhVTFaD469mW9wO194AaABAg.9gJzxwFcnPU9gORqKw5t W_)
https://www.youtube.com/watch?v=f7xZivqLZxc&lc=Ugyb8nmKKoXvcdM58gV4AaABAg (https://www.youtube.com/watch?v=f7xZivqLZxc&lc=Ugyb8nmKKoXvcdM58gV4AaABAg)
https://www.youtube.com/watch?v=f7xZivqLZxc&lc=UgwvvXcl1oa79xS7BAV4AaABAg (https://www.youtube.com/watch?v=f7xZivqLZxc&lc=UgwvvXcl1oa79xS7BAV4AaABAg)
https://www.youtube.com/watch?v=f7xZivqLZxc&lc=UgxvIFArksPprylHXYZ4AaABAg (https://www.youtube.com/watch?v=f7xZivqLZxc&lc=UgxvIFArksPprylHXYZ4AaABAg)
https://www.youtube.com/watch?v=f7xZivqLZxc&lc=Ugxq4JHRza_zx3sz0fx4AaABAg (https://www.youtube.com/watch?v=f7xZivqLZxc&lc=Ugxq4JHRza_zx3sz0fx4AaABAg)
https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA (https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA)


https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA (https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA)
https://www.youtube.com/watch?v=nVy4GAtkh7Q&lc=UgxJGNhWFZh2p5mK0XB4AaABAg.9bbxud383FI9c-vOQApTgb (https://www.youtube.com/watch?v=nVy4GAtkh7Q&lc=UgxJGNhWFZh2p5mK0XB4AaABAg.9bbxud383FI9c-vOQApTgb)
https://www.youtube.com/watch?v=nVy4GAtkh7Q&lc=UgxJGNhWFZh2p5mK0XB4AaABAg.9bbxud383FI9c-vbihZ-7W (https://www.youtube.com/watch?v=nVy4GAtkh7Q&lc=UgxJGNhWFZh2p5mK0XB4AaABAg.9bbxud383FI9c-vbihZ-7W)
https://www.youtube.com/watch?v=nVy4GAtkh7Q&lc=UgxJGNhWFZh2p5mK0XB4AaABAg.9bbxud383FI9c-vfmpSO0F (https://www.youtube.com/watch?v=nVy4GAtkh7Q&lc=UgxJGNhWFZh2p5mK0XB4AaABAg.9bbxud383FI9c-vfmpSO0F)
https://www.youtube.com/watch?v=nVy4GAtkh7Q&lc=UgxJGNhWFZh2p5mK0XB4AaABAg.9bbxud383FI9c-vjfTJ7lX (https://www.youtube.com/watch?v=nVy4GAtkh7Q&lc=UgxJGNhWFZh2p5mK0XB4AaABAg.9bbxud383FI9c-vjfTJ7lX)
https://www.youtube.com/watch?v=nVy4GAtkh7Q&lc=UgxJGNhWFZh2p5mK0XB4AaABAg.9bbxud383FI9c-vmq-LHHz (https://www.youtube.com/watch?v=nVy4GAtkh7Q&lc=UgxJGNhWFZh2p5mK0XB4AaABAg.9bbxud383FI9c-vmq-LHHz)
https://www.youtube.com/watch?v=nVy4GAtkh7Q&lc=UgxJGNhWFZh2p5mK0XB4AaABAg.9bbxud383FI9c-vst3j_7i (https://www.youtube.com/watch?v=nVy4GAtkh7Q&lc=UgxJGNhWFZh2p5mK0XB4AaABAg.9bbxud383FI9c-vst3j_7i)
https://www.youtube.com/watch?v=nVy4GAtkh7Q&lc=UgxJGNhWFZh2p5mK0XB4AaABAg.9bbxud383FI9bwBqjIR5 Nj (https://www.youtube.com/watch?v=nVy4GAtkh7Q&lc=UgxJGNhWFZh2p5mK0XB4AaABAg.9bbxud383FI9bwBqjIR5 Nj)
https://www.youtube.com/watch?v=nVy4GAtkh7Q&lc=UgxJGNhWFZh2p5mK0XB4AaABAg.9bbxud383FI9bwBw8El0 r5 (https://www.youtube.com/watch?v=nVy4GAtkh7Q&lc=UgxJGNhWFZh2p5mK0XB4AaABAg.9bbxud383FI9bwBw8El0 r5)
https://www.youtube.com/watch?v=nVy4GAtkh7Q&lc=UgxJGNhWFZh2p5mK0XB4AaABAg.9bbxud383FI9bwC63GbR uM (https://www.youtube.com/watch?v=nVy4GAtkh7Q&lc=UgxJGNhWFZh2p5mK0XB4AaABAg.9bbxud383FI9bwC63GbR uM)
https://www.youtube.com/watch?v=nVy4GAtkh7Q&lc=UgxJGNhWFZh2p5mK0XB4AaABAg.9bbxud383FI9bwC9fyKZ do (https://www.youtube.com/watch?v=nVy4GAtkh7Q&lc=UgxJGNhWFZh2p5mK0XB4AaABAg.9bbxud383FI9bwC9fyKZ do)
https://www.youtube.com/watch?v=nVy4GAtkh7Q&lc=UgxJGNhWFZh2p5mK0XB4AaABAg.9bbxud383FI9bwCEn8DB Qe (https://www.youtube.com/watch?v=nVy4GAtkh7Q&lc=UgxJGNhWFZh2p5mK0XB4AaABAg.9bbxud383FI9bwCEn8DB Qe)
https://www.youtube.com/watch?v=nVy4GAtkh7Q&lc=UgxJGNhWFZh2p5mK0XB4AaABAg.9bbxud383FI9bw0Bey8g QO (https://www.youtube.com/watch?v=nVy4GAtkh7Q&lc=UgxJGNhWFZh2p5mK0XB4AaABAg.9bbxud383FI9bw0Bey8g QO)
https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA (https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA)
rich_cirillo
06-21-2013, 01:31 AM
Updated

Hi

I require a macro to enter data..I enter data into Sheet 1 for each day.When i have all 5 days of data filled i press a button (macro) and it inserts the data into Sheet 2 matching the dates in Sheet 2 (sheet 1 and Sheet 2 dates must be an exact match to enter).....it enters the names,numbers and average,,Sheet 1 data will go into Sheet 2 cells C5:N10,,,,,,i also need a button to delete the names,numbers and average from sheet 1 once entered in Sheet 2.....is it possible that the data cannot be deleted from Sheet 1 unless it has been entered in Sheet 2....

When i change the date in Sheet 1 B2 to the 1/7/2013 again when all the data is entered i then press the macro button and it enters the data into the 1/7/2013 to 5/7/2013 range (C12:N17)

Once the data is entered into Sheet 2 it is permanent....

Thanks

Rich
rich_cirillo
06-22-2013, 01:42 PM
If code is not possible maybe a formula would work..
Admin
06-22-2013, 02:41 PM
Hi

Try this.


Option Explicit

Sub kTest()

Dim d, i As Long, k, q, x, r As Long
Dim c As Long, lRow As Long, Rng As Range

lRow = Sheet2.Range("b" & Sheet2.Rows.Count).End(3).Row
Set Rng = Sheet2.Range("b5:n" & lRow)
d = Rng.Value2
q = Application.Index(d, 0, 1)
k = Sheet1.Range("b6:n11").Value2

x = Application.Match(k(1, 1), q, 0)
If Not IsError(x) Then
If Len(d(x, 2)) * Len(d(x, 3)) Then 'check 2 columns whether they have data in those cells
MsgBox "It seems data already been entered for date " & CDate(k(1, 1))
Exit Sub
Else
For r = 1 To UBound(k, 1)
For c = 1 To UBound(k, 2)
d(r + x - 1, c) = k(r, c)
Next
Next
End If
Else
Set Rng = Sheet2.Range("b5:n" & lRow + 7)
d = Rng.Value2
For r = 1 To UBound(k, 1)
For c = 1 To UBound(k, 2)
d(UBound(d, 1) - UBound(k, 1) + r, c) = k(r, c)
Next
Next
End If
Rng = d
Rng.Columns(1).NumberFormat = "m/d/yyyy"
Sheet1.Range("c6:n10").ClearContents

End Sub
rich_cirillo
06-22-2013, 03:33 PM
Hi Admin
Impressive. Thank you and the code works exactly how I hoped it would
May I please finish this off with a couple of changes

I have changed the range slightly.Can the code copy the yellow cells (Sheet 1 C21:L21) into the cell range in Sheet 2 which is D3:M3 , D12:M12 , D21:M21 etc..etc..down to row 300 and the other cells copies as you programmed with dates matching

Can the button "transfer data to sheet 2" only be allowed to transfer data to sheet 2 if all 5 days have data entered

Can the button "clear data" be included in the code,Can the data only be cleared if the data has been transferred to sheet 2

Thanks for all your time

Rich
Admin
06-22-2013, 07:32 PM
Hi

Try this. Assign these macro to corresponding buttons.



Option Explicit

Sub kTest()

Dim d, i As Long, k, q, x, r As Long, Rng1 As Range
Dim c As Long, lRow As Long, Rng2 As Range, Hdr

lRow = Sheet2.Range("c" & Sheet2.Rows.Count).End(3).Row
Set Rng2 = Sheet2.Range("c3:m" & lRow)
d = Rng2.Value2
q = Application.Index(d, 0, 1)

Set Rng1 = Sheet1.Range("b32:l37")
Hdr = Sheet1.Range("c21:l21")

If Application.WorksheetFunction.CountA(Rng1) = Rng1.Cells.Count Then
k = Rng1.Value2

x = Application.Match(k(1, 1), q, 0)
If Not IsError(x) Then
If Len(d(x, 2)) * Len(d(x, 3)) Then 'check 2 columns whether they have data in those cells
MsgBox "It seems data already been entered for date " & CDate(k(1, 1))
Exit Sub
Else
For r = 1 To UBound(k, 1)
For c = 1 To UBound(k, 2)
d(r + x - 1, c) = k(r, c)
Next
Next
For c = 2 To UBound(d, 2): d(x - 1, c) = Hdr(1, c - 1): Next
End If
Else
Set Rng2 = Sheet2.Range("c3:m" & lRow + 9)
d = Rng2.Value2
For r = 1 To UBound(k, 1)
For c = 1 To UBound(k, 2)
d(UBound(d, 1) - UBound(k, 1) + r, c) = k(r, c)
Next
Next
For c = 2 To UBound(d, 2): d(UBound(d, 1) - UBound(k, 1), c) = Hdr(1, c - 1): Next
End If
Rng2 = d
Rng2.Columns(1).NumberFormat = "m/d/yyyy"
With Rng2.Resize(Rng2.Rows.Count + 2, Rng2.Columns.Count)
.BorderAround , xlThin
.Borders(xlInsideHorizontal).Weight = xlThin
.Borders(xlInsideVertical).Weight = xlThin
.Rows.RowHeight = 25
End With
End If

End Sub

Sub ClearData()

Sheet1.Range("b32:l36").ClearContents

End Sub
rich_cirillo
06-23-2013, 01:15 PM
Hi Admin

Thanks.Works excellent

Could you please make a final alteration

1. If all data is not entered in Sheet 1 C32:L36 ( all 5 days must have data) and the button "Transfer to Sheet 2" is pressed then it displays a message "cannot transfer until all data entered"

2. The data in Sheet 1 C32:L36 cannot be deleted unless it has been transferred to Sheet 2.....eg if only 3 days have data and the button "clear data" is pressed then a warning message says "cannot be deleted as incomplete"...the data will not be cleared...

Thanks again

Rich
Admin
06-23-2013, 04:01 PM
Try



Option Explicit

Sub kTest()

Dim d, i As Long, k, q, x, r As Long, Rng1 As Range
Dim c As Long, lRow As Long, Rng2 As Range, Hdr

lRow = Sheet2.Range("c" & Sheet2.Rows.Count).End(3).Row
Set Rng2 = Sheet2.Range("c3:m" & lRow)
d = Rng2.Value2
q = Application.Index(d, 0, 1)

Set Rng1 = Sheet1.Range("b32:l37")
Hdr = Sheet1.Range("c21:l21")

If Application.WorksheetFunction.CountA(Rng1) = Rng1.Cells.Count Then
k = Rng1.Value2

x = Application.Match(k(1, 1), q, 0)
If Not IsError(x) Then
If Len(d(x, 2)) * Len(d(x, 3)) Then 'check 2 columns whether they have data in those cells
MsgBox "It seems data already been entered for date " & CDate(k(1, 1))
Exit Sub
Else
For r = 1 To UBound(k, 1)
For c = 1 To UBound(k, 2)
d(r + x - 1, c) = k(r, c)
Next
Next
For c = 2 To UBound(d, 2): d(x - 1, c) = Hdr(1, c - 1): Next
End If
Else
Set Rng2 = Sheet2.Range("c3:m" & lRow + 9)
d = Rng2.Value2
For r = 1 To UBound(k, 1)
For c = 1 To UBound(k, 2)
d(UBound(d, 1) - UBound(k, 1) + r, c) = k(r, c)
Next
Next
For c = 2 To UBound(d, 2): d(UBound(d, 1) - UBound(k, 1), c) = Hdr(1, c - 1): Next
End If
Rng2 = d
Rng2.Columns(1).NumberFormat = "m/d/yyyy"
With Rng2.Resize(Rng2.Rows.Count + 2, Rng2.Columns.Count)
.BorderAround , xlThin
.Borders(xlInsideHorizontal).Weight = xlThin
.Borders(xlInsideVertical).Weight = xlThin
.Rows.RowHeight = 25
End With
Else
MsgBox "Cannot transfer until all data entered", vbCritical
End If

End Sub

Sub ClearData()

Dim Rng As Range

Set Rng = Sheet1.Range("b32:l37")

If Application.WorksheetFunction.CountA(Rng) = Rng.Cells.Count Then
Sheet1.Range("b32:l36").ClearContents
Else
MsgBox "Cannot be deleted as incomplete", vbCritical
End If

End Sub
rich_cirillo
06-23-2013, 04:15 PM
Hi Admin
Excellent.Thank you as the VBA works as asked for..

Just curious but would a formula have been able to get the data to enter into Sheet2 from Sheet1.....say when data is entered into sheet1 17/6/2013 then it enters that data into Sheet2 for the 17/6/2013.....when data is entered in Sheet1 for 18/6/2013 then it also enters into Sheet2 for the 18/6/2013 and so on....The names in yellow are on;y changed once a week on a Monday...just curious

Thanks again for your help

Rich
rich_cirillo
06-23-2013, 04:24 PM
Hi Admin

Can the following be altered

I added all the data in Sheet 1 and before I pressed the button "transfer to sheet 2" I hit the "Clear Data" button and it deleted the data before I transferred it to Sheet 2....can the Clear Data button only clear data if the data has been transferred to Sheet 2 first...can a message "Transfer data to sheet 2"
Admin
06-23-2013, 04:28 PM
I would say try yourself first and comeback if it not worked. That way you will learn something.
rich_cirillo
06-23-2013, 04:32 PM
Hi Admin

I think the VBA code is excellent....I will try and see what I get

Can the following be altered...this will finish all requirements

I added all the data in Sheet 1 and before I pressed the button "transfer to sheet 2" I hit the "Clear Data" button and it deleted the data before I transferred it to Sheet 2....can the Clear Data button only clear data if the data has been transferred to Sheet 2 first...can a message "Transfer data to sheet 2"

Thanks
rich_cirillo
06-24-2013, 02:00 PM
Hi Admin
I renamed the sheets and changed in the VBA code but now i get a Runtime Error - 1004 Application defined-or object defined error...was working exactly as programmed until i changed the sheet names..

Can the following be altered...this will finish all requirements

I added all the data in Sheet 1 and before I pressed the button "transfer to sheet 2" I hit the "Clear Data" button and it deleted the data before I transferred it to Sheet 2....can the Clear Data button only clear data if the data has been transferred to Sheet 2 first...can a message "Transfer data to sheet 2"

Thanks

Rich
Admin
06-24-2013, 05:05 PM
Hi

It should be L37 and L21 rather than 137 and 121.
rich_cirillo
06-24-2013, 06:17 PM
Hi Admin

Thanks

Can we finish this with a final alteration to the Clear Data code...can the Clear Data button only be functional once the data for that week has been entered into Records sheet...once the data has been Transferred to the Record Sheet by pressing the Transfer Data To Records button then the Data can be cleared

Thanks

Rich