Move data around in workbook

[MRichmond]

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.

[Aussiebear]

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?

[MRichmond]

Here's my recording


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

[georgiboy]

Something like:

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

[MRichmond]

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

[MRichmond]

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.

[Aussiebear]

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.

[MRichmond]

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.

[georgiboy]

Maybe:

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

[MRichmond]

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