Previous Topic Next Topic

Transfer data to individual sheets from Master sheet.

Closed
Thomanni - Updated on Nov 21, 2017 at 04:49 AM
vcoolio Posts 1411 Registration date Thursday July 24, 2014 Status Moderator Last seen September 6, 2024 - Nov 21, 2017 at 01:54 AM
Hello,

I am currently building a worksheet to track where cars are at a certain time. I have three places the car could be (west bullpen) (East Bullpen) or (Complete). These are displayed in the sheet labeled "To Do". I would like it if I put an x on the column labeled west bullpen or the column labeled East bullpen and the whole row be moved to the sheet labeled west bullpen or east bullpen. If the column Labeled Complete is marked with an x I would like for the row to be sent to complete and deleted from the To Do sheet. To be clear if I mark the west or east bullpen column, I would like for the row to remain on the To Do sheet. I only want the row deleted if it is marked complete. Thank you so much for your help, I have been stuck all day

Related:

1 response

Answer 1 / 1
vcoolio Posts 1411 Registration date Thursday July 24, 2014 Status Moderator Last seen September 6, 2024 262
Nov 21, 2017 at 01:54 AM
Hello Thomanni,

Following is the link to a little sample that I have prepared for you:-

http://ge.tt/1DiLYQn2

It will give you an idea of how this can work for you.

A multiple Worksheet_Change event may be what you need in this case since your "X" criteria are in three different columns.

Firstly, place the following codes in a standard module:- 

Option Compare Text
Sub TransferData1(ByVal Target As Range)

    Dim C As Range, rng As Range
    Set rng = Intersect(Range("F:F"), Target)
    If rng Is Nothing Then Exit Sub

    For Each C In rng
        If C.Value = "X" Then
           C.EntireRow.Copy Sheet2.Range("A" & Rows.Count).End(3)(2)
               End If
        Next C

End Sub

Sub TransferData2(ByVal Target As Range)

    Dim C As Range, rng As Range
    Set rng = Intersect(Range("G:G"), Target)
    If rng Is Nothing Then Exit Sub

    For Each C In rng
        If C.Value = "X" Then
           C.EntireRow.Copy Sheet3.Range("A" & Rows.Count).End(3)(2)
               End If
        Next C

End Sub
Sub TransferData3(ByVal Target As Range)

    Dim C As Range, rng As Range
    Set rng = Intersect(Range("H:H"), Target)
    If rng Is Nothing Then Exit Sub

    For Each C In rng
        If C.Value = "X" Then
           C.EntireRow.Copy Sheet4.Range("A" & Rows.Count).End(3)(2)
              C.EntireRow.Delete
              End If
        Next C

End Sub


Secondly, place the following code in the "To Do" sheet module:- 

Private Sub Worksheet_Change(ByVal Target As Range)

    On Error Resume Next

    TransferData1 Target
    TransferData2 Target
    TransferData3 Target
 
 Application.EnableEvents = True

    End Sub


Now, in the sample file, each time that you place an "X" in one of the three columns (F, G, H) and click away or press enter or down arrow, the codes will transfer the relevant row of data to its appropriate sheet. In the case of the "Complete" column, the data will be removed from Sheet1 ("To Do") also.

You may have to change the ranges (F,G,H) to suit your file but if you're not sure, just call back here for further help.

The code is case insensitive so if you enter a lower case or upper case "X" it will still work.

Test the code in a copy of your file first.

I hope that this helps.

Cheerio,
vcoolio.
0