Move data around in workbook

I have a workbook, and it consists of many worksheets. The main worksheet is called Raw Data. In here, is sometimes up to 80,000 rows of data, most of which will stay on this worksheet, but some rows need to be deleted, some need to be copied to another worksheet, and some need to be copied to another worksheet and then deleted from Raw Data.

In Column DL, I manually filter looking for CNC, these rows are just deleted. Again in Column DL I manually filter this time on Night, and these rows are copied to the worksheet called Night, and then they are deleted from Raw Data worksheet. Finally in column CK I manually filter, this time I exclude blanks (values will be numeric between 1 & 5, or be blank), These are copied onto the worksheet Feedback, but also remain on Raw Data.

I can do all this manually, but I'm trying to speed up the process, and researching the web has only made me more confused. I've tried recording the steps, but just can't seem to get it to work as intended with anything other than the test file

I'm using Excel 365, and ideally I would like the VBA to be stored in my personal macro workbook, rather than the file itself.

Any help will be gratefully received.

Actually I'm impressed that you have tried to record your steps to speed up this activity. Can you indicate to us your steps undertaken to process the procedure?

Here's my recording

Code:

---

Sub Macro1()
'
' Macro1 Macro
' Report set up
'
' Keyboard Shortcut: Ctrl+Shift+W
'


    ActiveSheet.Range("$A$1:$DM$4494").AutoFilter Field:=116, Criteria1:= _
        "CNC"
    Rows("1303:1303").Select
    Range("CT1303").Activate
    Selection.Delete Shift:=xlUp
    ActiveSheet.Range("$A$1:$DM$4493").AutoFilter Field:=116, Criteria1:= _
        "Night"
    Range("A1322").Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlToLeft)).Select
    Selection.Copy
    Sheets("Night").Select
    Range("A2").Select
    ActiveSheet.Paste
    Range("A1").Select
    Sheets("Raw Data").Select
    Application.CutCopyMode = False
    Rows("1322:1426").Select
    Range("CU1322").Activate
    Selection.Delete Shift:=xlUp
End Sub

---

Something like:

Code:

---

Sub test()   
    Dim wsRD As Worksheet, wsNight As Worksheet, wsFB As Worksheet
    Dim rRng As Range
   
    Set wsRD = Sheets("Raw Data")
    Set wsNight = Sheets("Night")
    Set wsFB = Sheets("Feedback")
    Set rRng = wsRD.UsedRange
   
    With rRng
        .AutoFilter 116, "CNC"
        .Offset(1).Resize(.Rows.Count - 1).Delete xlUp
        .AutoFilter 116, "Night"
        .Offset(1).Resize(.Rows.Count - 1).Copy
        wsNight.Range("A" & wsNight.Range("A" & Rows.Count).End(xlUp).Row + 1).PasteSpecial xlAll
        Application.CutCopyMode = False
        .Offset(1).Resize(.Rows.Count - 1).Delete xlUp
        wsRD.ShowAllData
        .AutoFilter 89, "<>"
        .Offset(1).Resize(.Rows.Count - 1).Copy
        wsFB.Range("A" & wsFB.Range("A" & Rows.Count).End(xlUp).Row + 1).PasteSpecial xlAll
        Application.CutCopyMode = False
        wsRD.ShowAllData
    End With
End Sub

---

Georgiboy, thanks you very much. Your something like works perfectly (no idea what it all means, but it works brilliantly):thumb.:beerchug:

OK, so update on this. The VBA supplied works perfectly, most of the time. The times it fails is when there are no rows with "CNC" or "Night" in column 116, so I suspect I need to incorporate some error checking, but no idea where to start. Any help gratefully received.

Quote:

---

Originally Posted by MRichmond

The VBA supplied works perfectly, most of the time. The times it fails is when there are no rows with "CNC" or "Night" in column 116,...

---

What do you mean it "fails"? As you have indicated you are auto filtering the worksheet "Raw Data" based on three conditions. "CNC" & "Night" in column DL (116) and then on a Numeric Value (1 to 5) in Column CK (89). The code doesn't run an autofilter if the values don't exist.

Quote:

---

Originally Posted by Aussiebear

What do you mean it "fails"? As you have indicated you are auto filtering the worksheet "Raw Data" based on three conditions. "CNC" & "Night" in column DL (116) and then on a Numeric Value (1 to 5) in Column CK (89). The code doesn't run an autofilter if the values don't exist.

---

Sorry, I should have been more descriptive.

When I run the VBA, if neither "CNC" & "Night" exist in that particular days data, then I get a message box with the following
Run-time error '1004': Application-defined or object-defined error
It then removes all data from the Raw Data tab.

If "CNC" exists, but "Night" doesn't or "Night" exists but "CNC" doesn't, I get the same issue as above.

Maybe:

Code:

---

Sub test()   
    Dim wsRD As Worksheet, wsNight As Worksheet, wsFB As Worksheet
    Dim rRng As Range
   
    Set wsRD = Sheets("Raw Data")
    Set wsNight = Sheets("Night")
    Set wsFB = Sheets("Feedback")
    Set rRng = wsRD.UsedRange
   
    With rRng
        .AutoFilter 116, "CNC"
        If Application.Subtotal(3, rRng(, 116).EntireColumn) > 1 Then
            .Offset(1).Resize(.Rows.Count - 1).Delete xlUp
        End If
        .AutoFilter 116, "Night"
        If Application.Subtotal(3, rRng(, 116).EntireColumn) > 1 Then
            .Offset(1).Resize(.Rows.Count - 1).Copy
            wsNight.Range("A" & wsNight.Range("A" & Rows.Count).End(xlUp).Row + 1).PasteSpecial xlAll
            Application.CutCopyMode = False
            .Offset(1).Resize(.Rows.Count - 1).Delete xlUp
        End If
        wsRD.ShowAllData
        .AutoFilter 89, "<>"
        .Offset(1).Resize(.Rows.Count - 1).Copy
        wsFB.Range("A" & wsFB.Range("A" & Rows.Count).End(xlUp).Row + 1).PasteSpecial xlAll
        Application.CutCopyMode = False
        wsRD.ShowAllData
    End With
End Sub

---

georgiboy strikes again. That slight tweak is exactly what I needed. Thanks very much for your time and effort in sorting for me.:beerchug::beerchug::cloud9::thumb