Trying to copy data from one sheet to another based on cell criteria

[Darnell7007]

Hello!

I have a set of data on a tab "All" - this data is raw and unfiltered - new rows are being added each week. Based on certain criteria, "Y" or "N" in column M, I would like the rows where the value in column M equals "N" to be copied onto a second sheet "Current" and the rows where the value in M is "Y" onto a third sheet "Returned". I've tried VLOOKUP and a Pivot Table - I couldn't get the Pivot Table to format how my team prefers to read the data, and I can't get the VLOOKUP to work. I have the logic I want, my issue is understanding how to translate that into a format Excel understands.

In essence: IF M2=Y, THEN copy row to Returned
IF M2=N, THEN copy row to Current


For the sake of time and data sensitivity, Column M in my real data will just become Column C in the example data below.
So my logic would then be: IF C2=Y, THEN copy row to Returned
IF C2=N, THEN copy row to Current

Customer Branch	Unit #	Y/N
2033	1539	Y
2051	5577	Y
2033	9463	N
2051	1582	Y
2051	7964	N
2051	1948	Y
2033	2577	Y
2033	1392	Y
2051	1284	N
2033	9536	N
2033	8676	N

I would use filters on the first tab and be done with it, but several teams use this file, and each team needs their own spreadsheet for Accounts Payable, Accounts Receivable, Transportation Management, etc., so I really need to be able to separate all this raw data from the first tab into the correct Department tabs.

 

[MikeVol]

Option Explicit

Sub CopyBasedOnM()
    Dim i           As Long

    Dim wsSource    As Worksheet
    Set wsSource = ThisWorkbook.Worksheets("All")

    Dim wsReturned  As Worksheet
    Set wsReturned = ThisWorkbook.Worksheets("Returned")

    Dim wsCurrent   As Worksheet
    Set wsCurrent = ThisWorkbook.Worksheets("Current")

    Dim lastRow     As Long
    lastRow = wsSource.Cells(wsSource.Rows.Count, "M").End(xlUp).Row

    Dim destRowReturned As Long
    destRowReturned = wsReturned.Cells(wsReturned.Rows.Count, "A").End(xlUp).Row + 1

    Dim destRowCurrent As Long
    destRowCurrent = wsCurrent.Cells(wsCurrent.Rows.Count, "A").End(xlUp).Row + 1
    Application.ScreenUpdating = False

    For i = 2 To lastRow

        Select Case wsSource.Cells(i, "M").Value
            Case "Y"
                wsSource.Rows(i).Copy wsReturned.Rows(destRowReturned)
                destRowReturned = destRowReturned + 1
            Case "N"
                wsSource.Rows(i).Copy wsCurrent.Rows(destRowCurrent)
                destRowCurrent = destRowCurrent + 1
        End Select

    Next i

    Set wsCurrent = Nothing
    Set wsReturned = Nothing
    Set wsSource = Nothing

    Application.ScreenUpdating = True
End Sub

 

[Darnell7007]

Option Explicit

Sub CopyBasedOnM()
    Dim i           As Long

    Dim wsSource    As Worksheet
    Set wsSource = ThisWorkbook.Worksheets("All")

    Dim wsReturned  As Worksheet
    Set wsReturned = ThisWorkbook.Worksheets("Returned")

    Dim wsCurrent   As Worksheet
    Set wsCurrent = ThisWorkbook.Worksheets("Current")

    Dim lastRow     As Long
    lastRow = wsSource.Cells(wsSource.Rows.Count, "M").End(xlUp).Row

    Dim destRowReturned As Long
    destRowReturned = wsReturned.Cells(wsReturned.Rows.Count, "A").End(xlUp).Row + 1

    Dim destRowCurrent As Long
    destRowCurrent = wsCurrent.Cells(wsCurrent.Rows.Count, "A").End(xlUp).Row + 1
    Application.ScreenUpdating = False

    For i = 2 To lastRow

        Select Case wsSource.Cells(i, "M").Value
            Case "Y"
                wsSource.Rows(i).Copy wsReturned.Rows(destRowReturned)
                destRowReturned = destRowReturned + 1
            Case "N"
                wsSource.Rows(i).Copy wsCurrent.Rows(destRowCurrent)
                destRowCurrent = destRowCurrent + 1
        End Select

    Next i

    Set wsCurrent = Nothing
    Set wsReturned = Nothing
    Set wsSource = Nothing

    Application.ScreenUpdating = True
End Sub

Thank you for this! I've never dabbled in VBAs, but I figured out how to enter it and it does exactly what I need it to do. Thank you so so much for the help!!!

 

[Darnell7007]

I've noticed a discrepancy with the data that's been copied to the other tabs. On the "All" tab, there are a total of 459 rows of data. On the Current tab, there are 753 rows of data - which is impossible.
I did adjust a setting so that the Macro ran each time the file was opened. I tested this 2 or 3 times to ensure there were no errors upon opening. However, each time I opened the file, it would duplicate everything on the "Current" and "Returned" tabs. So, since I opened the file 3 times, all the rows on "Current" have been duplicated twice, making 3 copies of the data on that one sheet.

Is there a way to have the VBA run upon opening or at regular intervals as the "All" tab is updated but to where it won't duplicate data and paste it multiple times on each tab?

 

[alansidman]

With Power Query.
1. Load your table/range to the PQ Editor (Data-->Get and Transform Data-->From Range/Table)
2. In the PQ Editor, filter for Y
3. Close and Load to New Worksheet
4. Open the PQ Editor and on the left side, duplicate the existing Query
5. Delete the last step in the New query
6. Filter the new query for N
7. Close and load to New Worksheet

any changes to the original data set. Click on data-->Refresh all and your two outputs will update.

 

[MikeVol]

Sorry, I was busy and didn't have my computer at hand.
Let's assume that you have unique values in the Unit # (L) column. Then we can use Scripting.Dictionary to track unique values. If the value in "L" is already in the Dictionary, the row is skipped. If the value is unique, it is added to the Dictionary and copied to the desired sheet. Now uniqueVal contains only the values from wsReturned and wsCurrent. I explained it as best I could, don't judge me too harshly.
Here is the code that will help you solve your problem with

However, each time I opened the file, it would duplicate everything on the "Current" and "Returned" tabs. So, since I opened the file 3 times, all the rows on "Current" have been duplicated twice, making 3 copies of the data on that one sheet.

Option Explicit

Sub CopyBasedOnM_NoDups()
    Dim i           As Long
    Dim cellValue   As Variant
    Dim rng As Range, cell As Range

    Dim wsSource    As Worksheet
    Set wsSource = ThisWorkbook.Worksheets("All")

    Dim wsReturned  As Worksheet
    Set wsReturned = ThisWorkbook.Worksheets("Returned")

    Dim wsCurrent   As Worksheet
    Set wsCurrent = ThisWorkbook.Worksheets("Current")

    Dim lastRow     As Long
    lastRow = wsSource.Cells(wsSource.Rows.Count, "M").End(xlUp).Row

    Dim destRowReturned As Long
    destRowReturned = wsReturned.Cells(wsReturned.Rows.Count, "A").End(xlUp).Row + 1

    Dim destRowCurrent As Long
    destRowCurrent = wsCurrent.Cells(wsCurrent.Rows.Count, "A").End(xlUp).Row + 1

    Dim uniqueVal   As Object
    Set uniqueVal = CreateObject("Scripting.Dictionary")

    Dim lastRowReturned As Long
    lastRowReturned = wsReturned.Cells(wsReturned.Rows.Count, "L").End(xlUp).Row

    Dim lastRowCurrent As Long
    lastRowCurrent = wsCurrent.Cells(wsCurrent.Rows.Count, "L").End(xlUp).Row
    Application.ScreenUpdating = False

    If lastRowReturned > 1 Then
        Set rng = wsReturned.Range("L2:L" & lastRowReturned)

        For Each cell In rng

            If Not uniqueVal.exists(cell.Value) And Len(cell.Value) > 0 Then
                uniqueVal.Add cell.Value, True
            End If

        Next cell

    End If

    If lastRowCurrent > 1 Then
        Set rng = wsCurrent.Range("L2:L" & lastRowCurrent)

        For Each cell In rng

            If Not uniqueVal.exists(cell.Value) And Len(cell.Value) > 0 Then
                uniqueVal.Add cell.Value, True
            End If

        Next cell

    End If

    For i = 2 To lastRow
        cellValue = wsSource.Cells(i, "L").Value

        If Len(cellValue) > 0 And Not uniqueVal.exists(cellValue) Then

            Select Case wsSource.Cells(i, "M").Value
                Case "Y"
                    wsSource.Rows(i).Copy wsReturned.Rows(destRowReturned)
                    destRowReturned = destRowReturned + 1
                Case "N"
                    wsSource.Rows(i).Copy wsCurrent.Rows(destRowCurrent)
                    destRowCurrent = destRowCurrent + 1
            End Select

            uniqueVal.Add cellValue, True
        End If

    Next i

    Set rng = Nothing
    Set uniqueVal = Nothing
    Set wsCurrent = Nothing
    Set wsReturned = Nothing
    Set wsSource = Nothing

    Application.ScreenUpdating = True
End Sub

Yes, the code is a bit big, maybe someone can write you a more optimal code. Good luck.