VBA for moving row to another sheet

T

torz

New Member
Joined
Sep 18, 2011
Messages
18
Hey guys,

I have absolutely no idea what I have mixed up here...

I tried a bunch of different sample codes and some seems to overwrite the last row instead of going to the next blank row (only every now and then, not every time).

But the current code in the sample seems to be working to a point... It copies the entire rows to the new sheets fine, have not seen it overwrite anything at all yet.

The issue is when it copies to the remediation complete sheet the account number seems to get an additional value added to it from somewhere. Eg

account number 1 --> remediation sheet the account number changes to be 3

please see the sample sheet (excel 2010) will make it a lot easier than trying to explain. :P (must be having a total spastic day, cant seem to upload the sample so code below)


Code: 
Private Sub Worksheet_Change(ByVal Target As Range)

Dim sht As Worksheet
Dim nxtRow As Integer
Dim lRow As Long


    'Determine if change was to Column C (3)
    If Target.Column = 15 Then
    'If Yes, Determine if cell = "Remediation Complete"
        If Target.Value = "Remediation Complete" Then
            Set sht = Worksheets("Reporting Sheet")
            lRow = sht.Cells(Rows.count, 1).End(xlUp).Offset(1, 0).Row
            With sht
                .Cells(lRow, 1).Value = Target.Cells.Offset(Target.Row, -14).Value
                .Cells(lRow, 2).Value = Target.Cells.Offset(Target.Row, -13).Value
                .Cells(lRow, 3).Value = Target.Cells.Offset(Target.Row, -12).Value
                .Cells(lRow, 4).Value = Target.Cells.Offset(Target.Row, -11).Value
                .Cells(lRow, 5).Value = Target.Cells.Offset(Target.Row, -10).Value
                .Cells(lRow, 6).Value = Target.Cells.Offset(Target.Row, -9).Value
                .Cells(lRow, 7).Value = Target.Cells.Offset(Target.Row, -8).Value
                .Cells(lRow, 8).Value = Target.Cells.Offset(Target.Row, -7).Value
                .Cells(lRow, 9).Value = Target.Cells.Offset(Target.Row, -6).Value
                .Cells(lRow, 10).Value = Target.Cells.Offset(Target.Row, -5).Value
                .Cells(lRow, 11).Value = Target.Cells.Offset(Target.Row, -4).Value
                .Cells(lRow, 12).Value = Target.Cells.Offset(Target.Row, -3).Value
                .Cells(lRow, 13).Value = Target.Cells.Offset(Target.Row, -2).Value
            End With
            'Delete changed row now that account has been remediated & moved to the Reporting Sheet
            Target.EntireRow.Delete
        ElseIf Target.Value = "O2A iTam" Or Target.Value = "Tibco iTam" Or Target.Value = "Kenan iTam" Or Target.Value = "Other iTam" Or Target.Value = "Disconnect Inprogress" Then
            'If Yes, find next empty row in Reporting Sheet
            Set sht = Worksheets("Outstanding - iTams")
            lRow = sht.Cells(Rows.count, 1).End(xlUp).Offset(1, 0).Row
            'Copy changed row and paste into Reporting Sheet
            Target.EntireRow.Copy Destination:=sht.Range("A" & lRow)
            'Delete changed row now that account has been remediated & moved to the Reporting Sheet
            Target.EntireRow.Delete
        ElseIf Target.Value = "Customer Contact" Then
            'If Yes, find next empty row in Reporting Sheet
            Set sht = Worksheets("Outstanding - Customer Contact")
            lRow = sht.Cells(Rows.count, 1).End(xlUp).Offset(1, 0).Row
            'Copy changed row and paste into Reporting Sheet
            Target.EntireRow.Copy Destination:=sht.Range("A" & lRow)
            'Delete changed row now that account has been remediated & moved to the Reporting Sheet
            Target.EntireRow.Delete
        ElseIf Target.Value = "Open Copy" Then
            'If Yes, find next empty row in Reporting Sheet
            Set sht = Worksheets("Outstanding - Open Copy Order")
            lRow = sht.Cells(Rows.count, 1).End(xlUp).Offset(1, 0).Row
            'Copy changed row and paste into Reporting Sheet
            Target.EntireRow.Copy Destination:=sht.Range("A" & lRow)
            'Delete changed row now that account has been remediated & moved to the Reporting Sheet
            Target.EntireRow.Delete
        End If
    End If
    
End Sub
 

Excel Facts

When they said...
When they said you are going to "Excel at life", they meant you "will be doing Excel your whole life".
Sort by date Sort by votes
I think I understand what you wanted, however I got lost in your code. I tried to recreate the logic with simpler code. Some thoughts on this KIS model for coding.

Target, as passed as an argument, is a range of cells. I think you want to run this only if one cell is changed.
Code: 
Set TargetCell = Target.Cells(1, 1)             ' check just one cell?

I’m not a fan of setting up variables to point to objects. It seems to me to just add another layer to look at. I recommend using the “with” approach:
Code: 
[FONT=microsoft sans serif]With Worksheets("Reporting Sheet")[/FONT]
Instead of:
Code: 
dim sht
Set sht = Worksheets("Reporting Sheet") 
With sht
Compound if statements give me a headache. I substituted a easier to read (for me anyway) Select Case logic
Code: 
Select Case TargetCell.Value

When code is repeated, substitute a separate routine
Code: 
FixWS "Outstanding - Customer Contact", TargetCell

With all that, here is some code that does what I think you wanted

Create a test excel document
Put this code into the module for the sheet in which the column 15 cell changes
Test and Test
Post results

Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim lRow As Long
    Dim i As Integer
    Dim TargetCell
    Set TargetCell = Target.Cells(1, 1)             ' check just one cell?
    If TargetCell.Column <> 15 Then Exit Sub
    Select Case TargetCell.Value
        Case "Remediation Complete"
            With Worksheets("Reporting Sheet")
                lRow = .Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
                For i = 1 To 13
                    .Cells(lRow, i).Value = TargetCell.Offset(TargetCell.Row, i - 15).Value
                Next i
            End With
        Case "O2A iTam", "Tibco iTam", "Kenan iTam", "Other iTam", "Disconnect Inprogress"
            FixWS "Outstanding - iTams", TargetCell
        Case "Customer Contact"
            FixWS "Outstanding - Customer Contact", TargetCell
        Case "Open Copy"
            FixWS "Outstanding - Open Copy Order", TargetCell
        Case Else
           '  "Unknown value: " & TargetCell.Value
    End Select
End Sub
Sub FixWS(sht, tc)
    Dim iRow, iHeader
    With Sheets(sht)
        iRow = .Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
        If Application.WorksheetFunction.CountA(.Columns("A")) = 0 Then iRow = 1
        tc.EntireRow.Copy Destination:=.Range("A" & iRow)
        tc.EntireRow.Delete
    End With
End Sub
 
Upvote 0
Hey mate,

Thanks heaps for giving it a shot! :)
100% correct, this is so much easier to read than previous... but we have ended up in a worse place than before. it now changes the number in the person column as well.

So here is a snapshot of the sample sheet (we'll call it the working sheet)

[TABLE="width: 1640"]
<tbody>[TR]
[TD]RESOURCE_NAME[/TD]
[TD]REMEDIATION_DATE[/TD]
[TD]account[/TD]
[TD]OCC[/TD]
[TD]TDU[/TD]
[TD]CR[/TD]
[TD]EOFY[/TD]
[TD]UCD[/TD]
[TD]TDU[/TD]
[TD]RR[/TD]
[TD]EOFY[/TD]
[TD]PA[/TD]
[TD]REMEDIATION_NOTES[/TD]
[TD]StartDate[/TD]
[TD]Remediation_Status[/TD]
[TD]EOFY[/TD]
[TD]Months_until_EOFY[/TD]
[TD]NotifyMeOn[/TD]
[/TR]
[TR]
[TD]Person2[/TD]
[TD]13/12/2012[/TD]
[TD]2[/TD]
[TD]$5.00[/TD]
[TD]11[/TD]
[TD]$0.00[/TD]
[TD]$0.00[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]asdfadfg[/TD]
[TD]asdfadfg[/TD]
[TD][/TD]
[TD][/TD]
[TD]2/02/2012[/TD]
[TD]5[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Person3[/TD]
[TD]14/12/2012[/TD]
[TD]3[/TD]
[TD]$3.00[/TD]
[TD]11[/TD]
[TD]$0.00[/TD]
[TD]$0.00[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]asdfadfg[/TD]
[TD]asdfadfg[/TD]
[TD][/TD]
[TD][/TD]
[TD]2/02/2012[/TD]
[TD]5[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Person4[/TD]
[TD]15/12/2012[/TD]
[TD]4[/TD]
[TD]$1.00[/TD]
[TD]11[/TD]
[TD]$0.00[/TD]
[TD]$0.00[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]asdfadfg[/TD]
[TD]asdfadfg[/TD]
[TD][/TD]
[TD][/TD]
[TD]2/02/2012[/TD]
[TD]5[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Person5[/TD]
[TD]16/12/2012[/TD]
[TD]5[/TD]
[TD]$3.00[/TD]
[TD]11[/TD]
[TD]$0.00[/TD]
[TD]$0.00[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]asdfadfg[/TD]
[TD]asdfadfg[/TD]
[TD][/TD]
[TD][/TD]
[TD]2/02/2012[/TD]
[TD]5[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Person6[/TD]
[TD]17/12/2012[/TD]
[TD]6[/TD]
[TD]$43.00[/TD]
[TD]11[/TD]
[TD]$0.00[/TD]
[TD]$0.00[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]asdfadfg[/TD]
[TD]asdfadfg[/TD]
[TD][/TD]
[TD][/TD]
[TD]2/02/2012[/TD]
[TD]5[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Person7[/TD]
[TD]18/12/2012[/TD]
[TD]7[/TD]
[TD]$4.00[/TD]
[TD]11[/TD]
[TD]$0.00[/TD]
[TD]$0.00[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]asdfadfg[/TD]
[TD]asdfadfg[/TD]
[TD][/TD]
[TD][/TD]
[TD]2/02/2012[/TD]
[TD]5[/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]
Click to expand...

So I have pasted the code you had into this sheet & when you change the Remediation status to the completed status it does not delete the row from the working sheet & when it copies the data to the reporting sheet this is the output

[TABLE="width: 1619"]
<colgroup><col><col><col><col><col><col><col><col><col><col><col><col><col></colgroup><tbody>[TR]
[TD]RESOURCE_NAME[/TD]
[TD]REMEDIATION_DATE[/TD]
[TD]account[/TD]
[TD]OCC[/TD]
[TD]TDU[/TD]
[TD]CR[/TD]
[TD]EOFY[/TD]
[TD]UCD[/TD]
[TD]TDU2[/TD]
[TD]RR[/TD]
[TD]EOFY3[/TD]
[TD]PA[/TD]
[TD]REMEDIATION_NOTES[/TD]
[/TR]
[TR]
[TD]Person4[/TD]
[TD="align: right"]15/12/2012[/TD]
[TD="align: right"]4[/TD]
[TD="align: right"]$1.00[/TD]
[TD="align: right"]11[/TD]
[TD="align: right"]$0.00[/TD]
[TD="align: right"]$0.00[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]asdfadfg[/TD]
[TD]asdfadfg[/TD]
[/TR]
[TR]
[TD]Person6[/TD]
[TD="align: right"]17/12/2012[/TD]
[TD="align: right"]6[/TD]
[TD="align: right"]$43.00[/TD]
[TD="align: right"]11[/TD]
[TD="align: right"]$0.00[/TD]
[TD="align: right"]$0.00[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]asdfadfg[/TD]
[TD]asdfadfg[/TD]
[/TR]
[TR]
[TD]Person4[/TD]
[TD="align: right"]15/12/2012[/TD]
[TD="align: right"]4[/TD]
[TD="align: right"]$1.00[/TD]
[TD="align: right"]11[/TD]
[TD="align: right"]$0.00[/TD]
[TD="align: right"]$0.00[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]asdfadfg[/TD]
[TD]asdfadfg[/TD]
[/TR]
</tbody>[/TABLE]
Click to expand...

So I've highlighted the rows so you know which row I said was completed.
I did Person2 twice and Person 3 once.

So when it is copied to the new sheet it is changing the PersonX number and it is also changing the account number which seems to be doubling the actual number from the working sheet, the $ figures are incorrect as well...

On a positive note, it still only copies the required columns over and leaves the ones I don't want in the reporting sheet out :)

 
Upvote 0
Ahhh I think I see what its doing, I just still don't know why... It is coping the wrong row to the reporting sheet. So when I said Person2 is complete it copies the details from 2 rows below (Person4 Details) & same for Person3 except instead of 2 rows down it copies the details from 3 rows below the active row.
 
Upvote 0
Welcome to the Board!

Instead of copying the complete items to a new sheet, why not just use a pivot table to summarize that information?
 
Upvote 0
Smitty said:
Welcome to the Board!

Instead of copying the complete items to a new sheet, why not just use a pivot table to summarize that information?
Click to expand...


That was my original plan, but they don't want it like that for some reason, I find it so much easier to work with personally but maybe that's just me...
 
Upvote 0
torz said:
That was my original plan, but they don't want it like that for some reason, I find it so much easier to work with personally but maybe that's just me...
Click to expand...

It's not just you, but Pivot Tables are often misunderstood. If you have Excel 2010+ I'd suggest building a sample using some Slicers just to show how powerful they can be.
 
Upvote 0
Now back into the "Way back" machine.

1. The reason it started in the second row is due to the fact that I didn't have any headers in mine.
2. The reason it didn't delete the row is that I left out a delete row command.
3. The fix for not "moving" cells was due to the non use of the "ActiveSheet"


So, give this a try and post the results

Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim lRow As Long
    Dim i As Integer
    Dim TargetCell
    Set TargetCell = Target.Cells(1, 1)             ' check just one cell?
    If TargetCell.Column <> 15 Then Exit Sub
    Select Case TargetCell.Value
        Case "Remediation Complete"
            With Worksheets("Reporting Sheet")
                lRow = .Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
               [COLOR=#008000] '-------------------------------------------
                ' account for no row (including header)
                If Application.WorksheetFunction.CountA(.Columns("A")) = 0 Then lRow = 1[/COLOR]
                For i = 1 To 13
                ' fix for correct worksheet
                    .Cells(lRow, i).Value = [COLOR=#0000cd]ActiveSheet[/COLOR].Cells(TargetCell.Row, i).Value
                Next i
            End With
        [COLOR=#a52a2a]'------------------------------------
        ' delete the row just processed
        ActiveSheet.Rows(TargetCell.Row).EntireRow.Delete[/COLOR]
        Case "O2A iTam", "Tibco iTam", "Kenan iTam", "Other iTam", "Disconnect Inprogress"
            FixWS "Outstanding - iTams", TargetCell
        Case "Customer Contact"
            FixWS "Outstanding - Customer Contact", TargetCell
        Case "Open Copy"
            FixWS "Outstanding - Open Copy Order", TargetCell
        Case Else
           '  "Unknown value: " & TargetCell.Value
    End Select
End Sub
Sub FixWS(sht, tc)
    Dim iRow
    With Sheets(sht)
        iRow = .Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
        If Application.WorksheetFunction.CountA(.Columns("A")) = 0 Then iRow = 1
        tc.EntireRow.Copy Destination:=.Range("A" & iRow)
    End With
    ActiveSheet.Rows(tc.Row).EntireRow.Delete
End Sub
 
Upvote 0
tlowry said:
Now back into the "Way back" machine.

1. The reason it started in the second row is due to the fact that I didn't have any headers in mine.
2. The reason it didn't delete the row is that I left out a delete row command.
3. The fix for not "moving" cells was due to the non use of the "ActiveSheet"


So, give this a try and post the results

Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim lRow As Long
    Dim i As Integer
    Dim TargetCell
    Set TargetCell = Target.Cells(1, 1)             ' check just one cell?
    If TargetCell.Column <> 15 Then Exit Sub
    Select Case TargetCell.Value
        Case "Remediation Complete"
            With Worksheets("Reporting Sheet")
                lRow = .Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
               [COLOR=#008000] '-------------------------------------------
                ' account for no row (including header)
                If Application.WorksheetFunction.CountA(.Columns("A")) = 0 Then lRow = 1[/COLOR]
                For i = 1 To 13
                ' fix for correct worksheet
                    .Cells(lRow, i).Value = [COLOR=#0000cd]ActiveSheet[/COLOR].Cells(TargetCell.Row, i).Value
                Next i
            End With
        [COLOR=#a52a2a]'------------------------------------
        ' delete the row just processed
        ActiveSheet.Rows(TargetCell.Row).EntireRow.Delete[/COLOR]
        Case "O2A iTam", "Tibco iTam", "Kenan iTam", "Other iTam", "Disconnect Inprogress"
            FixWS "Outstanding - iTams", TargetCell
        Case "Customer Contact"
            FixWS "Outstanding - Customer Contact", TargetCell
        Case "Open Copy"
            FixWS "Outstanding - Open Copy Order", TargetCell
        Case Else
           '  "Unknown value: " & TargetCell.Value
    End Select
End Sub
Sub FixWS(sht, tc)
    Dim iRow
    With Sheets(sht)
        iRow = .Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
        If Application.WorksheetFunction.CountA(.Columns("A")) = 0 Then iRow = 1
        tc.EntireRow.Copy Destination:=.Range("A" & iRow)
    End With
    ActiveSheet.Rows(tc.Row).EntireRow.Delete
End Sub
Click to expand...

thanks for all the help lowry! still does the same thing, does not remove the active row after changing the status
and that is the Person2 one again so all the figures are being copied from row #4 instead of row #2

[TABLE="width: 1591"]
<colgroup><col><col><col><col><col><col><col><col><col><col><col><col><col></colgroup><tbody>[TR]
[TD]RESOURCE_NAME[/TD]
[TD]REMEDIATION_DATE[/TD]
[TD]account[/TD]
[TD]OCC[/TD]
[TD]TDU[/TD]
[TD]CR[/TD]
[TD]EOFY[/TD]
[TD]UCD[/TD]
[TD]TDU[/TD]
[TD]RR[/TD]
[TD]EOFY[/TD]
[TD]PA[/TD]
[TD]REMEDIATION_NOTES[/TD]
[/TR]
[TR]
[TD]Person5[/TD]
[TD="align: right"]16/12/2012[/TD]
[TD="align: right"]5[/TD]
[TD="align: right"]$3.00[/TD]
[TD="align: right"]11[/TD]
[TD="align: right"]$0.00[/TD]
[TD="align: right"]$0.00[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]asdfadfg[/TD]
[TD]asdfadfg[/TD]
[/TR]
</tbody>[/TABLE]
Click to expand...
 
Upvote 0
You must log in or register to reply here.

Similar threads

R
  • Solved
VBA moving rows
2
Replies
14
Views
869
Joe4
Joe4
J
  • Question Question
Search folder for value and list left/right value
Replies
2
Views
212
JJCam
J
J
  • Solved
Run time error for Worksheet Change in VBA
2
Replies
17
Views
395
jtemp57
J
E
  • Question Question
Estimating Spreadsheet-Summing
Replies
1
Views
339
Peter_SSs
Peter_SSs
K
  • Locked
  • Question Question
Vba code for User history log which is giving me a run-time error "13" mismatch
Replies
2
Views
138
Fluff
Fluff

Forum statistics

Threads
1,223,214
Messages
6,170,771
Members
452,353
Latest member
strainu

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