Code help to transfer data to another sheet and delete data from original sheet

[englandmark]

Hi all
Could use some help with a code, below is what I need to achieve:
1) Select row(s) in "Sheet Log" if the value in column k of the row equals Yes.
2) Copy selected rows.
3) Paste selected rows into "Sheet Record" on the first blank row available and then every other blank row after that if there is more than one to do at a time.
4) Delete the selected rows that were just copied from "Sheet Log"
Thanks in advance
Mark

 

[Mike LH]

Hi,

Try this

Sub somesub()
Dim LastRow As Long, C As Range
Dim Myrange As Range, CopyRange As Range
Dim Src As Worksheet, Dst As Worksheet
Set Src = Sheets("Sheet Log")
Set Dst = Sheets("Sheet Record")
LastRow = Src.Cells(Rows.Count, "K").End(xlUp).Row
Set Myrange = Src.Range("K2:K" & LastRow)

For Each C In Myrange
    If UCase(C.Value) = "YES" Then
        If CopyRange Is Nothing Then
                Set CopyRange = C.EntireRow
        Else
                Set CopyRange = Union(CopyRange, C.EntireRow)
        End If
    End If
Next
If Not CopyRange Is Nothing Then
    LastRow = Dst.Cells(Rows.Count, "K").End(xlUp).Row
    CopyRange.Copy Dst.Cells(LastRow + 1, "A")
End If
End Sub

 

[englandmark]

not working
this is link to work book
trying to get it to automatically transfer data to record and delete from log when yes selected
https://onedrive.live.com/redir?resid=76085382C8B8530C!2429

 

[Mike LH]

not working
this is link to work book
trying to get it to automatically transfer data to record and delete from log when yes selected
https://onedrive.live.com/redir?resid=76085382C8B8530C!2429

I had to change the worksheet names in the code because the ones you gave in your first post were incorrect but apart from that It's working fine for me. I uploaded the workbook to my Onedrive; link below. Same filename of Equipment tracker Richmond Hill.xlsm

https://onedrive.live.com/?cid=66A66EA84229B01B&id=66A66EA84229B01B!108

 

[englandmark]

it transfers the data to record but doesn't delete it from the log sheet
can it be deleted automatically from the log sheet and copy to the record sheet and without a button

 

[Mike LH]

Hi,

One additional line required try this

Sub somesub()
Dim LastRow As Long, C As Range
Dim Myrange As Range, CopyRange As Range
Dim Src As Worksheet, Dst As Worksheet
Set Src = Sheets("Log")
Set Dst = Sheets("Record")
LastRow = Src.Cells(Rows.Count, "K").End(xlUp).Row
Set Myrange = Src.Range("K2:K" & LastRow)

For Each C In Myrange
    If UCase(C.Value) = "YES" Then
        If CopyRange Is Nothing Then
                Set CopyRange = C.EntireRow
        Else
                Set CopyRange = Union(CopyRange, C.EntireRow)
        End If
    End If
Next
If Not CopyRange Is Nothing Then
    LastRow = Dst.Cells(Rows.Count, "K").End(xlUp).Row
    CopyRange.Copy Dst.Cells(LastRow + 1, "A")
    CopyRange.Delete
End If
End Sub

 

[englandmark]

I hate to be a pain but still pretty new to VBA
this is a log for my coordinator and its hard enough to get her to complete the fields.
what I need is when she chooses yes (rental complete) it automatically transfers all the data and same formatting to the record sheet and deletes the data from the log sheet.
Also rather than blank spaces it would be best if it could delete not just the data but the row.
Thanks for the help.
I'm originally from Pompey but currently living in US, hope the reds are doing well

 

[Mike LH]

Hi,

To my absolute dismay the Reds are not doing OK. When Fenway of Boston Red Sox fame took over I had high hopes but so far ... we'll see next season.

Back to the question. if your coordinator changes a cell in Col K to YES then the data get moved to the other sheet. To install this code you right click the sheet tab, view code and paste the code in on the right.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim LastRow As Long, Dst As Worksheet
Dim Response
Set Dst = Sheets("Record")
MsgBox Target.Value
If Intersect(Target, Columns(11)) Is Nothing Then Exit Sub
Application.EnableEvents = False
If UCase(Target.Value) = "YES" Then
    LastRow = Dst.Cells(Rows.Count, "K").End(xlUp).Row
    Target.EntireRow.Copy Dst.Cells(LastRow + 1, "A")
    Target.EntireRow.Delete
End If
Application.EnableEvents

= True
End Sub

 

[Mike LH]

The code got a bit messed up. I missed with my code tags use this one.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim LastRow As Long, Dst As Worksheet
Dim Response
Set Dst = Sheets("Record")
MsgBox Target.Value
If Intersect(Target, Columns(11)) Is Nothing Then Exit Sub
Application.EnableEvents = False
If UCase(Target.Value) = "YES" Then
    LastRow = Dst.Cells(Rows.Count, "K").End(xlUp).Row
    Target.EntireRow.Copy Dst.Cells(LastRow + 1, "A")
    Target.EntireRow.Delete
End If
Application.EnableEvents = True
End Sub

 

[englandmark]

Mike, need your help again
On one sheet, Bid Log. I would like the entire row to turn a color if a cell on another sheet is not blank.
Therefore when my estimator enters a bid amount on his work sheet the estimate row on the bid log will turn his color so I know he has estimated