Copy row based on value in a cell

[vbogesjo]

Hi,

I am looking for a way to copy a row, or even better 6 cells in a row if one defined cell (in that row) contains a certain value.

Here is the thing:
I have a table, say from A1 to F80, sometimes I would like to "Archive" a row in that table by moving the contents in these cells to a second sheet. Column F is originally blank and when I enter the word "Yes" and press a button, I would like that row (or if possible that row's cells A to E) to copy it's contents to Sheet 2 A100 to E180. (NB A100 to E180 as I would like to be able to fill in several "Yes" at the same time).

I will then sort the cells in Sheet 2 A1 to E180 so it wont be any problem to copy in further cells from Sheet 1 next time I fill in "Yes" and press the button.

When the cells have been copied I would also like to clear the content in the cells in the copied rows (i.e. in Sheet 1 A1 to F80). NB not delete cells but clear content.

Please note that I would like a button to activate this function.

Is this even possible?

If anyone finds a sollution I would be very very grateful.

Many thanks in advance.

 

[manmah]

Hi Try this

Sub UpdateLogWorksheet()
Dim historyWks As Worksheet
Dim inputWks As Worksheet
Dim nextRow As Long
Dim oCol As Long
Dim myRng As Range
Dim myCopy As String
Dim myCell As Range

'cells to copy from Input sheet - some contain formulas
myCopy = "D8,F8,D10,D12,D14,G14,D16,G16,D18,D20,G20,D22,D24,D28,G28,F30"
Set inputWks = Worksheets("Sheet1")
Set historyWks = Worksheets("Sheet2")
With historyWks
nextRow = .Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0).Row
End With
With inputWks
Set myRng = .Range(myCopy)
End With
With historyWks
With .Cells(nextRow, "A")
.Value = Now
.NumberFormat = "mm/dd/yyyy hh:mm:ss"
End With
.Cells(nextRow, "B").Value = Application.UserName
oCol = 3
For Each myCell In myRng.Cells
historyWks.Cells(nextRow, oCol).Value = myCell.Value
oCol = oCol + 1
Next myCell
End With
Dim c As Range
'clear input cells that contain constants
With inputWks
On Error Resume Next
For Each c In Sheets("Sheet1").UsedRange
If c.Locked = False Then
c.Value = ""
End If
Next
Application.GoTo .Cells(1) ', Scroll:=True
On Error GoTo 0
End With
End Sub

Change the red cells to the cells you wish to copy
These will come up in sheet 2 on the second line down and each subsequent send will be shown on the next line down.
Sheet 1 will need to be protected and the cells you are sending unlocked so they clear. It will also record the person logged in and the date and time in columns A & B on sheet 2. To make a simple button just draw a square anywhere on sheet 1 and assign macro.
Hope this helps you..
Mark

 

[Jameo]

Public Sub CopyData()
 
Dim LRow As Long, LRow1 As Long
Dim WS1 As Worksheet, WS2 As Worksheet
 
Set WS1 = Sheets("Sheet1")
Set WS2 = Sheets("Sheet2")
 
LRow = WS1.Range("A" & Rows.Count).End(xlUp).Row
 
For i = 2 To LRow
    LRow1 = WS2.Range("A" & Rows.Count).End(xlUp).Row
    If WS1.Cells(i, 6).Value = "YES" Then
        WS1.Cells(i, 1).EntireRow.Copy Destination:=WS2.Cells(1, LRow1)
 
    End If
Next i
End Sub

Change the code in red to your relevent sheet reference and cell reference. Add a command button, right hand click and assign to the above macro. Note that Cells(i, 6) is a cell reference, where i = row i, 6 = column 6 (i.e. "F")

Every time you run the above, any "YES" will be copied. If you need to keep re-running the macro every so often you would have the potential of duplicating your archived data, if you do not delete the "YES"'s. You could add the above to automatically remove the "YES"'s on running the macro.

Public Sub CopyData()
 
Dim LRow As Long, LRow1 As Long
Dim WS1 As Worksheet, WS2 As Worksheet
 
Set WS1 = Sheets("Sheet1")
Set WS2 = Sheets("Sheet2")
 
LRow = WS1.Range("A" & Rows.Count).End(xlUp).Row
 
For i = 2 To LRow
    LRow1 = WS2.Range("A" & Rows.Count).End(xlUp).Row
    If WS1.Cells(i, 6).Value = "YES" Then
        WS1.Cells(i, 1).EntireRow.Copy Destination:=WS2.Cells(1, LRow1)
        WS1.Cells(i, 6).Value = ""
 
    End If
Next i
End Sub

Hope this helps

 

[Peter_SSs]

Welcome to the MrExcel board!

I don't quite understand what you are saying about sorting Sheet2, but see if this idea is any use to you. The code just adds each copied row to the bottom of the data in Sheet2 but the code could be amended to sort/move that data if required.

Please test in a copy of your workbook.

Instead of typing "Yes" in column F cells and then pressing a button, what about just double clicking in column F next to the row you want to move?

To implement ..

1. Right click the Sheet1 sheet name tab and choose "View Code".

2. Copy and Paste the code below into the main right hand pane that opens at step 1.

3. Close the Visual Basic window.

4. Double click in column F of rows you want to move.

(The code could be changed to work if you click any cell in the row, not just column F if you want that)

<font face=Courier New><br><SPAN style="color:#00007F">Private</SPAN> <SPAN style="color:#00007F">Sub</SPAN> Worksheet_BeforeDoubleClick(<SPAN style="color:#00007F">ByVal</SPAN> Target <SPAN style="color:#00007F">As</SPAN> Range, Cancel <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Boolean</SPAN>)<br>    <SPAN style="color:#00007F">If</SPAN> Target.Column = 6 <SPAN style="color:#00007F">Then</SPAN><br>        Cancel = <SPAN style="color:#00007F">True</SPAN><br>        <SPAN style="color:#00007F">With</SPAN> Cells(Target.Row, "A").Resize(, 5)<br>            .Cut Destination:= _<br>                Sheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Offset(1)<br>        <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">With</SPAN><br>    <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN><br>End <SPAN style="color:#00007F">Sub</SPAN><br></FONT>

 

[vbogesjo]

Manmah, Jameo & Peter_SSs,

Thank you very much for your replies.

I will go with Peter_SSs´s suggestion which is a very good solution for me. A follow-up question, not very important but if it worked it would be nice, is it possible to make a condition before activating the code for that row, say for example that a number has to be entered in the D-column before be able to dubble-click the F-column.

Once again, many thanks.

 

[Peter_SSs]

A follow-up question, not very important but if it worked it would be nice, is it possible to make a condition before activating the code for that row, say for example that a number has to be entered in the D-column before be able to dubble-click the F-column.

This change doesn't require a number as such, and doesn't stop you double clicking column F, but does require something in column D before the row is copied. Is that sufficient?

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    If Target.Column = 6 Then
        If Cells(Target.Row, "D").Value <> "" Then
            Cancel = True
            With Cells(Target.Row, "A").Resize(, 5)
                .Cut Destination:= _
                    Sheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Offset(1)
            End With
        End If
    End If
End Sub

 

[vbogesjo]

Perfect!

Many thanks!

Best regards,

 

[Jameo]

Quick question on that code for my own understanding Peter.

Why is is necessary to have "Cancel = True" in the proc? What does that particular line do?

Cheers

 

[Peter_SSs]

Quick question on that code for my own understanding Peter.

Why is is necessary to have "Cancel = True" in the proc? What does that particular line do?

Cheers

One of the Options in Excel is 'Allow editing directly in cells'. It is a user's personal choice but if they have that feature enabled, they can edit the contents of a cell by double clicking the cell rather than having to go to the formula bar.

If a user has that feature enabled and I did not have that line in the code then after the row was moved to the other sheet, the cell that was double clicked would be in edit mode.

So the Cancel = True is cancelling the normal double click action while this code runs, but only if the user double clicked a cell in column F and there is something in column D of that row. So a double click on another column or on a cell in col F where col D is empty would still allow the 'Edit directly in cell' to work.