Information overwriting when transferring

UTB

New Member
Joined
Jan 3, 2024
Messages
10
Office Version
  1. 365
  2. 2021
Platform
  1. Windows
Hi all,

I am in the final stages of a spreadsheet whereby I am trying (and largely succeeded) in automating a lot of the copy/paste at the click of a button type stuff to move my work to different tabs.

Through a lot of self learning, and a bit of help here and there from the amazing people on here, I have pretty much managed to get where I want it to be…..

However, as is always the case when it comes to stress testing it to see what bugs/issues I have, I have come across an issue I am struggling to amend and I am hoping it is just my lack of VBA ability that’s just causing what appears fixable but highly frustrating at the same time until I can do so…..


So, to give a picture, I have 4 tabs where I have jobs waiting to be allocated. Each tab relates to work in a different town.
I input information as it comes in and then click on a button I put at the top to transfer cells over to another tab (allocated jobs) when I have managed to allocate a job (all 4 town tabs feed into this one allocated jobs worksheet). At the same time, where a job has not been allocated but has paperwork to be done (Forms A and B), they also transfer the same data to the paperwork tab (regardless of whether a job has a persons allocated or not).

Again, at the click of a button on each town worksheet, it feeds into the paperwork tab just like allocated jobs.

The issue I am now having (and can’t work out why) is that when I click the button to move information from one town tab to the allocated jobs & paperwork tab - which is fine, but the next town tab, I click and it transfers over the information but actually overwrites the anything already in the paperwork tab.

Please see below the code I use for the three towns (code is the same just with the minor alteration of Town 1, Town 2 etc).

I would be very grateful if someone can help me get to the bottom of my errors.

Ultimately, my end goal is to transfer information from Row B downwards on each town tab (based on certain info when it comes to the paperwork element) to two worksheets within the same workbook when I click the button I have linked the code to but want it to input the information on the next available line and avoid any overwriting.

So near yet so far!!!

Many thanks in advance.

Town 1

VBA Code:
Sub Button2_Click()

'Set variables

Dim wsSource As Worksheet

Dim wsTarget As Worksheet

Dim iSourceLastRow As Long

Dim iTargetLastRow As Long

'Set variables for source and destination sheets

Set wsSource = Worksheets("Town 1")

Set wsTarget = Worksheets("Allocated Job")

'Find last used row in the source sheet based on data in column A

iSourceLastRow = wsSource.Cells(wsSource.Rows.Count, "A").End(xlUp).Row

'Find first blank row in the destination sheet based on data in column A

'Offset property is to move the copied data 1 row down

iTargetLastRow = wsTarget.Cells(wsTarget.Rows.Count, "A").End(xlUp).Offset(1).Row

'Copy data from the source and Paste in the destination

For Each cel In wsSource.Range("B3:B" & iSourceLastRow)

If Not IsEmpty(cel) Then

cel.Offset(, -1).Resize(1, 17).Copy wsTarget.Range("A" & iTargetLastRow)

iTargetLastRow = iTargetLastRow + 1

End If

Next cel

'Declare variables

Dim sheetNo1 As Worksheet

Dim sheetNo2 As Worksheet

Dim FinalRow As Long

Dim Cell As Range

'Set variables

Set sheetNo1 = Sheets("Town 1")

Set sheetNo2 = Sheets("Paperwork")

'Type a command to select the entire row

Selection.EntireRow.Select

' Define destination sheets to move row

FinalRow1 = sheetNo1.Range("A" & sheetNo1.Rows.Count).End(xlUp).Row

FinalRow2 = sheetNo2.Range("A" & sheetNo2.Rows.Count).End(xlUp).Row

With sheetNo1

'Apply loop for column P until last cell with value

For Each Cell In .Range("P3:P" & .Cells(.Rows.Count, "P").End(xlUp).Row)

'Apply condition to match the "Form A” value

If Cell.Value = "Form A" Then

'Command to Copy and move to a destination Sheet "Paperwork"

.Cells(Cell.Row, "A").Resize(, 16).Copy Destination:=sheetNo2.Cells(FinalRow2 + 1, "A")

FinalRow2 = FinalRow2 + 1

'Apply condition to match the "Form B" value

ElseIf Cell.Value = "Form B" Then

'Command to Copy and move to a destination Sheet "Paperwork"

.Cells(Cell.Row, "A").Resize(, 16).Copy Destination:=sheetNo2.Cells(FinalRow2 + 1, "A")

FinalRow2 = FinalRow2 + 1

MsgBox ("Visits have been transferred to Paperwork and Allocated Job")

End If

Next Cell

End With

End Sub

Town 2

VBA Code:
Sub Button2_Click()

'Set variables

Dim wsSource As Worksheet

Dim wsTarget As Worksheet

Dim iSourceLastRow As Long

Dim iTargetLastRow As Long

'Set variables for source and destination sheets

Set wsSource = Worksheets("Town 2")

Set wsTarget = Worksheets("Allocated Job")

'Find last used row in the source sheet based on data in column A

iSourceLastRow = wsSource.Cells(wsSource.Rows.Count, "A").End(xlUp).Row

'Find first blank row in the destination sheet based on data in column A

'Offset property is to move the copied data 1 row down

iTargetLastRow = wsTarget.Cells(wsTarget.Rows.Count, "A").End(xlUp).Offset(1).Row

'Copy data from the source and Paste in the destination

For Each cel In wsSource.Range("B3:B" & iSourceLastRow)

If Not IsEmpty(cel) Then

cel.Offset(, -1).Resize(1, 17).Copy wsTarget.Range("A" & iTargetLastRow)

iTargetLastRow = iTargetLastRow + 1

End If

Next cel

'Declare variables

Dim sheetNo1 As Worksheet

Dim sheetNo2 As Worksheet

Dim FinalRow As Long

Dim Cell As Range

'Set variables

Set sheetNo1 = Sheets("Town 2")

Set sheetNo2 = Sheets("Paperwork")

'Type a command to select the entire row

Selection.EntireRow.Select

' Define destination sheets to move row

FinalRow1 = sheetNo1.Range("A" & sheetNo1.Rows.Count).End(xlUp).Row

FinalRow2 = sheetNo2.Range("A" & sheetNo2.Rows.Count).End(xlUp).Row

With sheetNo1

'Apply loop for column P until last cell with value

For Each Cell In .Range("P3:P" & .Cells(.Rows.Count, "P").End(xlUp).Row)

'Apply condition to match the "Form A” value

If Cell.Value = "Form A" Then

'Command to Copy and move to a destination Sheet "Paperwork"

.Cells(Cell.Row, "A").Resize(, 16).Copy Destination:=sheetNo2.Cells(FinalRow2 + 1, "A")

FinalRow2 = FinalRow2 + 1

'Apply condition to match the "Form B" value

ElseIf Cell.Value = "Form B" Then

'Command to Copy and move to a destination Sheet "Paperwork"

.Cells(Cell.Row, "A").Resize(, 16).Copy Destination:=sheetNo2.Cells(FinalRow2 + 1, "A")

FinalRow2 = FinalRow2 + 1

MsgBox ("Visits have been transferred to Paperwork and Allocated Job")

End If

Next Cell

End With

End Sub

Town 3, 4 etc are the same as the above so it would just be duplication at this point.
 

Excel Facts

Save Often
If you start asking yourself if now is a good time to save your Excel workbook, the answer is Yes
Hi all,

I am in the final stages of a spreadsheet whereby I am trying (and largely succeeded) in automating a lot of the copy/paste at the click of a button type stuff to move my work to different tabs.

Through a lot of self learning, and a bit of help here and there from the amazing people on here, I have pretty much managed to get where I want it to be…..

However, as is always the case when it comes to stress testing it to see what bugs/issues I have, I have come across an issue I am struggling to amend and I am hoping it is just my lack of VBA ability that’s just causing what appears fixable but highly frustrating at the same time until I can do so…..


So, to give a picture, I have 4 tabs where I have jobs waiting to be allocated. Each tab relates to work in a different town.
I input information as it comes in and then click on a button I put at the top to transfer cells over to another tab (allocated jobs) when I have managed to allocate a job (all 4 town tabs feed into this one allocated jobs worksheet). At the same time, where a job has not been allocated but has paperwork to be done (Forms A and B), they also transfer the same data to the paperwork tab (regardless of whether a job has a persons allocated or not).

Again, at the click of a button on each town worksheet, it feeds into the paperwork tab just like allocated jobs.

The issue I am now having (and can’t work out why) is that when I click the button to move information from one town tab to the allocated jobs & paperwork tab - which is fine, but the next town tab, I click and it transfers over the information but actually overwrites the anything already in the paperwork tab.

Please see below the code I use for the three towns (code is the same just with the minor alteration of Town 1, Town 2 etc).

I would be very grateful if someone can help me get to the bottom of my errors.

Ultimately, my end goal is to transfer information from Row B downwards on each town tab (based on certain info when it comes to the paperwork element) to two worksheets within the same workbook when I click the button I have linked the code to but want it to input the information on the next available line and avoid any overwriting.

So near yet so far!!!

Many thanks in advance.

Town 1

VBA Code:
Sub Button2_Click()

'Set variables

Dim wsSource As Worksheet

Dim wsTarget As Worksheet

Dim iSourceLastRow As Long

Dim iTargetLastRow As Long

'Set variables for source and destination sheets

Set wsSource = Worksheets("Town 1")

Set wsTarget = Worksheets("Allocated Job")

'Find last used row in the source sheet based on data in column A

iSourceLastRow = wsSource.Cells(wsSource.Rows.Count, "A").End(xlUp).Row

'Find first blank row in the destination sheet based on data in column A

'Offset property is to move the copied data 1 row down

iTargetLastRow = wsTarget.Cells(wsTarget.Rows.Count, "A").End(xlUp).Offset(1).Row

'Copy data from the source and Paste in the destination

For Each cel In wsSource.Range("B3:B" & iSourceLastRow)

If Not IsEmpty(cel) Then

cel.Offset(, -1).Resize(1, 17).Copy wsTarget.Range("A" & iTargetLastRow)

iTargetLastRow = iTargetLastRow + 1

End If

Next cel

'Declare variables

Dim sheetNo1 As Worksheet

Dim sheetNo2 As Worksheet

Dim FinalRow As Long

Dim Cell As Range

'Set variables

Set sheetNo1 = Sheets("Town 1")

Set sheetNo2 = Sheets("Paperwork")

'Type a command to select the entire row

Selection.EntireRow.Select

' Define destination sheets to move row

FinalRow1 = sheetNo1.Range("A" & sheetNo1.Rows.Count).End(xlUp).Row

FinalRow2 = sheetNo2.Range("A" & sheetNo2.Rows.Count).End(xlUp).Row

With sheetNo1

'Apply loop for column P until last cell with value

For Each Cell In .Range("P3:P" & .Cells(.Rows.Count, "P").End(xlUp).Row)

'Apply condition to match the "Form A” value

If Cell.Value = "Form A" Then

'Command to Copy and move to a destination Sheet "Paperwork"

.Cells(Cell.Row, "A").Resize(, 16).Copy Destination:=sheetNo2.Cells(FinalRow2 + 1, "A")

FinalRow2 = FinalRow2 + 1

'Apply condition to match the "Form B" value

ElseIf Cell.Value = "Form B" Then

'Command to Copy and move to a destination Sheet "Paperwork"

.Cells(Cell.Row, "A").Resize(, 16).Copy Destination:=sheetNo2.Cells(FinalRow2 + 1, "A")

FinalRow2 = FinalRow2 + 1

MsgBox ("Visits have been transferred to Paperwork and Allocated Job")

End If

Next Cell

End With

End Sub

Town 2

VBA Code:
Sub Button2_Click()

'Set variables

Dim wsSource As Worksheet

Dim wsTarget As Worksheet

Dim iSourceLastRow As Long

Dim iTargetLastRow As Long

'Set variables for source and destination sheets

Set wsSource = Worksheets("Town 2")

Set wsTarget = Worksheets("Allocated Job")

'Find last used row in the source sheet based on data in column A

iSourceLastRow = wsSource.Cells(wsSource.Rows.Count, "A").End(xlUp).Row

'Find first blank row in the destination sheet based on data in column A

'Offset property is to move the copied data 1 row down

iTargetLastRow = wsTarget.Cells(wsTarget.Rows.Count, "A").End(xlUp).Offset(1).Row

'Copy data from the source and Paste in the destination

For Each cel In wsSource.Range("B3:B" & iSourceLastRow)

If Not IsEmpty(cel) Then

cel.Offset(, -1).Resize(1, 17).Copy wsTarget.Range("A" & iTargetLastRow)

iTargetLastRow = iTargetLastRow + 1

End If

Next cel

'Declare variables

Dim sheetNo1 As Worksheet

Dim sheetNo2 As Worksheet

Dim FinalRow As Long

Dim Cell As Range

'Set variables

Set sheetNo1 = Sheets("Town 2")

Set sheetNo2 = Sheets("Paperwork")

'Type a command to select the entire row

Selection.EntireRow.Select

' Define destination sheets to move row

FinalRow1 = sheetNo1.Range("A" & sheetNo1.Rows.Count).End(xlUp).Row

FinalRow2 = sheetNo2.Range("A" & sheetNo2.Rows.Count).End(xlUp).Row

With sheetNo1

'Apply loop for column P until last cell with value

For Each Cell In .Range("P3:P" & .Cells(.Rows.Count, "P").End(xlUp).Row)

'Apply condition to match the "Form A” value

If Cell.Value = "Form A" Then

'Command to Copy and move to a destination Sheet "Paperwork"

.Cells(Cell.Row, "A").Resize(, 16).Copy Destination:=sheetNo2.Cells(FinalRow2 + 1, "A")

FinalRow2 = FinalRow2 + 1

'Apply condition to match the "Form B" value

ElseIf Cell.Value = "Form B" Then

'Command to Copy and move to a destination Sheet "Paperwork"

.Cells(Cell.Row, "A").Resize(, 16).Copy Destination:=sheetNo2.Cells(FinalRow2 + 1, "A")

FinalRow2 = FinalRow2 + 1

MsgBox ("Visits have been transferred to Paperwork and Allocated Job")

End If

Next Cell

End With

End Sub

Town 3, 4 etc are the same as the above so it would just be duplication at this point.
Managed to sort it after more playing about. This can be disregarded.

Thanks
 
Upvote 0
OK, for future reference, please do not mark a particular post as the solution, unless the solution you used is actually posted in there.
If you want to post the details of how you fixed it, you can mark that post as the solution.
But please do not mark a post as the solution if the post does not actually contain the solution.
I have removed that for you on this post.
 
  • Like
Reactions: UTB
Upvote 0
OK, for future reference, please do not mark a particular post as the solution, unless the solution you used is actually posted in there.
If you want to post the details of how you fixed it, you can mark that post as the solution.
But please do not mark a post as the solution if the post does not actually contain the solution.
I have removed that for you on this post.
No problem, I did try to delete the post but wasn’t able to do so.

The issue was more with excel itself and the machine not the code which was sound.

Thanks
 
Upvote 0
Yeah, noobies do not have the ability to delete threads, and even when you do get that ability, you only have about 10 minutes after posting in order to do so.

Even if the solution was not strictly an Excel one, if you can describe what you did to fix it, you can post that and mark that as the solution.
It may help someone else some day, if they come across the same issue, and find this thread!

Or you can just reply back saying that this is no longer needed (which is what you did). Just if you do that, don't mark it as the solution (since it isn't one).
Think of it this way: Marking a post as a solution does NOT mean "this thread has been solved", it really means "this post contains the solution to the problem!".
 
  • Like
Reactions: UTB
Upvote 0
Brilliant. Thanks for the update and info and apologies for any confusion caused.
 
Upvote 0
No worries! We see you are fairly new here.
Hope you are enjoying the board!
:)
 
Upvote 0

Forum statistics

Threads
1,215,073
Messages
6,122,970
Members
449,095
Latest member
Mr Hughes

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