Move a whole row to a new worksheet row based on entry in one cell but not if input entry is in another cell

[RID]

Good afternoon, is there a formula that can be used to do the following, I have a worksheet for reviews that we have internal comments for our own use and responses to customer. I have a sneaky feeling that this will probably need some sort of VBA code but thought I would ask the question if can be done by formula first off. Currently we have that what ever is in column F on worksheet 1 is transferred into worksheet but as you can see when there is no entry in column F it still transfers the row because we have someting in column D.

If there is input in Column F 'Response to Customer' cells I would like to transfer the whole row onto a new worksheet which is the bottom screenshot, but if there is an input in Colum D 'Internal Comment' then the row is not transfered to the second worksheet.

Any pointers would be appreciated if I need to start looking at VBA where should I be looking at and is there specific tutorials that can get me going?

 

[mumps]

Replace the current macro with the code below. When you enter data in column F and press the RETURN key, the data will be copied to Doc 2. If you delete any existing data in column F, the corresponding data in Doc 2 will be cleared.

Dim oldVal As Long
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Target.CountLarge > 1 Then Exit Sub
    If Target.Column <> 6 Then Exit Sub
    oldVal = Range("A" & Target.Row).Value
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.CountLarge > 1 Then Exit Sub
    If Target.Column <> 6 Then Exit Sub
    Application.ScreenUpdating = False
    Dim desWS As Worksheet, lRow As Long, fnd As Range
    Set desWS = Sheets("Doc 2")
    lRow = desWS.Range("B" & Rows.Count).End(xlUp).Row
    If Target <> "" Then
        If Target.Offset(, -2) = "" Then
            With desWS
                If lRow = 2 Then
                    .Range("A" & lRow + 1).Resize(, 3).Value = Range("A" & Target.Row).Resize(, 3).Value
                    .Range("F" & lRow + 1).Value = Range("F" & Target.Row).Value
                Else
                    lRow = lRow + 7
                    .Range("A" & lRow).Resize(, 3).Value = Range("A" & Target.Row).Resize(, 3).Value
                    .Range("F" & lRow).Value = Range("F" & Target.Row).Value
                End If
            End With
        End If
    Else
        Set fnd = desWS.Range("A:A").Find(oldVal, LookIn:=xlValues, lookat:=xlWhole)
        If Not fnd Is Nothing Then
            desWS.Rows(fnd.Row).ClearContents
        End If
    End If
    Application.ScreenUpdating = True
End Sub

 

[RID]

Nope that didnt work mummps my input into column F no longer copies

 

[RID]

Also found another flaw, if I make a mistake in one of the column F cells and go back to sort it, instead of changing that cell with the new content it pastes the new row at the next available one and keeps the one with the original mistake in it

 

[mumps]

Try:

Dim oldVal As Long
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Target.CountLarge > 1 Then Exit Sub
    If Target.Column <> 6 Then Exit Sub
    oldVal = Range("A" & Target.Row).Value
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.CountLarge > 1 Then Exit Sub
    If Target.Column <> 6 Then Exit Sub
    Application.ScreenUpdating = False
    Dim desWS As Worksheet, lRow As Long, fnd As Range
    Set desWS = Sheets("Doc 2")
    lRow = desWS.Range("B" & Rows.Count).End(xlUp).Row
    If Target <> "" Then
        Set fnd = desWS.Range("A:A").Find(oldVal, LookIn:=xlValues, lookat:=xlWhole)
        If fnd Is Nothing Then
            If Target.Offset(, -2) = "" Then
                With desWS
                    If lRow = 2 Then
                        .Range("A" & lRow + 1).Resize(, 3).Value = Range("A" & Target.Row).Resize(, 3).Value
                        .Range("F" & lRow + 1).Value = Range("F" & Target.Row).Value
                    Else
                        lRow = lRow + 7
                        .Range("A" & lRow).Resize(, 3).Value = Range("A" & Target.Row).Resize(, 3).Value
                        .Range("F" & lRow).Value = Range("F" & Target.Row).Value
                    End If
                End With
            End If
        Else
            With desWS
                .Range("A" & fnd.Row).Resize(, 3).Value = Range("A" & Target.Row).Resize(, 3).Value
                .Range("F" & fnd.Row).Value = Range("F" & Target.Row).Value
            End With
        End If
    Else
        Set fnd = desWS.Range("A:A").Find(oldVal, LookIn:=xlValues, lookat:=xlWhole)
        If Not fnd Is Nothing Then
            desWS.Rows(fnd.Row).ClearContents
        End If
    End If
    Application.ScreenUpdating = True
End Sub

 

[RID]

Nope nothing getting copied at all now

 

[mumps]

I tested the code on the file you posted and it works properly. Can you upload a copy of the workbook that is not working for you?

 

[RID]

Yes sure here you go

GloQ 301 - Idea - Rev 2.xlsm | Powered by Box

app.box.com

 

[RID]

Just to note I changed the file name on the tab to client 1, so where it references Doc 2 in the code I swapped it out with Client 1

 

[mumps]

It looks like you want the code to work on all the "Doc" sheets and copy to the appropriate "Client" sheet. Is this correct?

 

[RID]

Yes if that can be done it would be great