Automatically copying rows with a particular attribute to a different worksheet

byronova

New Member
Joined
Oct 23, 2008
Messages
18
Hi. my problem involves displaying rows that meet certain ‘criteria’, on a separate worksheet, in real time. The criteria will be determined by a selection made from a dropdown list in the row in question.
<?xml:namespace prefix = o ns = "urn:schemas-microsoft-com:office:office" /><o:p></o:p>
ILLUSTRATION: Let us say (for example) that I am dealing with a worksheet for MEN’S DATA. Each man’s data will be on a separate row. On each row, one of the cells has a dropdown list having 2 options, SHORT and TALL. I have a separate report worksheet for TALL men. I mean, I want every row for which I select the TALL option, to be copied to my TALL report worksheet. I want the selection of the TALL option to be a kind of trigger that promptly copies the row to the TALL worksheet, once I make the selection from the dropdown list.

Any help I can get will be appreciated.
 
Last edited:
Is there a unique identifier in a defined position in the row that would enable searching for that in the 'wrong' sheet in order to remove it?

Edit: I see that you modified your post. So instead of the entire row you only want the values in column C. Are the names unique?


Hello VoG,

Well, the unique identifier could be the Names, which are unique. No, I have not modified the entire post, but in another report, i want to be able to see a list of names of all the current TALL and SHORT men.
 
Upvote 0
OK well this now just copies from column C to column A of TALL or SHORT. If the same value is found in the 'other' sheet it is removed. This will only function as intended if the values copied from column C are unique.

Code:
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Const FirstRow As Long = 10 'change 10 to the first row to start on
Dim LR As Long, ToFind As Variant, Found As Range, OtherSheet As String
If Target.Count > 1 Then Exit Sub
If Target.Value = "TALL" Or Target.Value = "SHORT" Then
    Application.EnableEvents = False
    With Sheets(Target.Value)
        LR = WorksheetFunction.Max(.Range("A" & Rows.Count).End(xlUp).Row + 1, FirstRow)
        ToFind = Sh.Range("C" & Target.Row)
        .Range("A" & LR).Value = ToFind
    End With
    If Target.Value = "TALL" Then
        OtherSheet = "SHORT"
    Else
        OtherSheet = "TALL"
    End If
    Set Found = Sheets(OtherSheet).Columns("A").Find(what:=ToFind)
    If Not Found Is Nothing Then Found.EntireRow.Delete
    Application.EnableEvents = True
End If
End Sub


Hello VoG,

Yes, the values copied from column c are unique, but i hope i can also modify the code to copy to, say, column B in the other report worksheet. also, i would like to be able to do something like this for the whole row as well. Thank you for your time.
 
Upvote 0
This will copy the whole row. I'm not sure what you mjean about copying to column B od another sheet - which sheet?

Code:
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Const FirstRow As Long = 10 'change 10 to the first row to start on
Dim LR As Long, ToFind As Variant, Found As Range, OtherSheet As String
If Target.Count > 1 Then Exit Sub
If Target.Value = "TALL" Or Target.Value = "SHORT" Then
    Application.EnableEvents = False
    With Sheets(Target.Value)
        LR = WorksheetFunction.Max(.Range("A" & Rows.Count).End(xlUp).Row + 1, FirstRow)
        ToFind = Sh.Range("C" & Target.Row)
        Target.EntireRow.Copy Destination:=.Range("A" & LR)
    End With
    If Target.Value = "TALL" Then
        OtherSheet = "SHORT"
    Else
        OtherSheet = "TALL"
    End If
    Set Found = Sheets(OtherSheet).Columns("C").Find(what:=ToFind)
    If Not Found Is Nothing Then Found.EntireRow.Delete
    Application.EnableEvents = True
End If
End Sub
 
Upvote 0
This will copy the whole row. I'm not sure what you mjean about copying to column B od another sheet - which sheet?

Code:
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Const FirstRow As Long = 10 'change 10 to the first row to start on
Dim LR As Long, ToFind As Variant, Found As Range, OtherSheet As String
If Target.Count > 1 Then Exit Sub
If Target.Value = "TALL" Or Target.Value = "SHORT" Then
    Application.EnableEvents = False
    With Sheets(Target.Value)
        LR = WorksheetFunction.Max(.Range("A" & Rows.Count).End(xlUp).Row + 1, FirstRow)
        ToFind = Sh.Range("C" & Target.Row)
        Target.EntireRow.Copy Destination:=.Range("A" & LR)
    End With
    If Target.Value = "TALL" Then
        OtherSheet = "SHORT"
    Else
        OtherSheet = "TALL"
    End If
    Set Found = Sheets(OtherSheet).Columns("C").Find(what:=ToFind)
    If Not Found Is Nothing Then Found.EntireRow.Delete
    Application.EnableEvents = True
End If
End Sub

Hello VoG,

the other sheet i was refering to is the report worksheet to which i plan to copy the name list in column b to. similar to the TALL worksheet which i told you about earlier.
 
Upvote 0
Try

Code:
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Const FirstRow As Long = 10 'change 10 to the first row to start on
Dim LR As Long, ToFind As Variant, Found As Range, OtherSheet As String
Dim LR2 As Long
LR2 = Sheets("Report").Range("B" & Rows.Count).End(.xlUp).Row
If Target.Count > 1 Then Exit Sub
If Target.Value = "TALL" Or Target.Value = "SHORT" Then
    Application.EnableEvents = False
    With Sheets(Target.Value)
        LR = WorksheetFunction.Max(.Range("A" & Rows.Count).End(xlUp).Row + 1, FirstRow)
        ToFind = Sh.Range("C" & Target.Row)
        Target.EntireRow.Copy Destination:=.Range("A" & LR)
        Range("C" & Target.Row).Copy Destination = Sheets("report").Range("B" & LR + 1)
        End With
    If Target.Value = "TALL" Then
        OtherSheet = "SHORT"
    Else
        OtherSheet = "TALL"
    End If
    Set Found = Sheets(OtherSheet).Columns("C").Find(what:=ToFind)
    If Not Found Is Nothing Then Found.EntireRow.Delete
    Application.EnableEvents = True
End If
End Sub
 
Upvote 0
Hello VoG,

You have been more helpful than i can say. I need to confirm though, that the last bit of code you sent does the following, Upon selecting the TALL or SHORT options:

a)Copies the TALL or SHORT row to the TALL or SHORT report worksheets

b)Copies the NAMES only of the TALL or SHORT people to another report worksheet

c)removes or adds the report sheet entries as the source worksheets are updated

Thank you.
 
Upvote 0
There were a couple of errors in the last code that I posted. This works

Code:
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Const FirstRow As Long = 10 'change 10 to the first row to start on
Dim LR As Long, ToFind As Variant, Found As Range, OtherSheet As String
Dim LR2 As Long
LR2 = Sheets("Report").Range("B" & Rows.Count).End(xlUp).Row
If Target.Count > 1 Then Exit Sub
If Target.Value = "TALL" Or Target.Value = "SHORT" Then
    Application.EnableEvents = False
    With Sheets(Target.Value)
        LR = WorksheetFunction.Max(.Range("A" & Rows.Count).End(xlUp).Row + 1, FirstRow)
        ToFind = Sh.Range("C" & Target.Row)
        Target.EntireRow.Copy Destination:=.Range("A" & LR)
        Range("C" & Target.Row).Copy Destination:=Sheets("Report").Range("B" & LR2 + 1)
        End With
    If Target.Value = "TALL" Then
        OtherSheet = "SHORT"
    Else
        OtherSheet = "TALL"
    End If
    Set Found = Sheets(OtherSheet).Columns("C").Find(what:=ToFind)
    If Not Found Is Nothing Then Found.EntireRow.Delete
    Application.EnableEvents = True
End If
End Sub

This does a) b) and c) but does not remove entries from the Report sheet since only the names are written there with no indication of their TALL/SHORT status.
 
Upvote 0
Dear VoG,

Sorry for the break in comms. i was out of touch with civilization for a spell. I feel that I need to aplogize to you, because i was giving so much information, piece by piece. In the light of this i also need to thank you, because, even with the patches of information i provided, you were still able to turn out goods. Only the best are able to do this. Thank you again for all your patience and advice thus far.

I have now tried to paint a more complete picture of the situation i am trying to handle here, with a slightly different illustration.

ILLUSTRATION: Let us say (for example) that I am dealing with a worksheet for BALLS DATA. Each ball’s data will be on a separate row. On each row, one of the cells (the ball’s COLOUR) has a dropdown list having 5 options, BLACK, BLUE, GREEN, RED, YELLOW. I have a separate report worksheet for balls of the same colour. <?xml:namespace prefix = o ns = "urn:schemas-microsoft-com:office:office" /><o:p></o:p>
I want every row for which I select the any particular colour option, to be copied to the corresponding report worksheet. For instance, while filling in data for a new green ball, once I select GREEN in the COLOUR dropdown list, that selection of the GREEN option should be a kind of trigger that promptly copies the whole row to the GREEN worksheet.<o:p></o:p>
I will give each ball a unique name. I also want to have separate report sheets listing only the names of the balls in each colour group.<o:p></o:p>
In summary, selecting any one of the BLACK, BLUE, GREEN, RED, YELLOW options should result in the following.<o:p></o:p>
a)Copies the row to the corresponding colour worksheet

b)Copies the NAMES only of the balls other report worksheets

c)removes or adds the report sheet entries as the source worksheets are updated
 
Upvote 0
As far as I can see the question and requirements are exactly the same, except now it's colours instead of Tall/Short, so you already have example code to work with.

You should also consider doing this in Access, where you can have dynamic queries and reports.
 
Upvote 0

Forum statistics

Threads
1,226,850
Messages
6,193,334
Members
453,790
Latest member
yassinosnoo1

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