Help - VBA code to move certain info from a Master Sheet to new sheets

ManxBen

New Member
Joined
Nov 15, 2016
Messages
3
Hi All, Looking for some help with a VBA code.

Each day I get a data download from one of our systems which compiles all completed, ongoing and cancelled cases.

I then have to manually go through the data to sort into 3 new sheets within the same workbook. With over 20,000 of data each day this can be quite mind numbing and slow.

I would like a code which will look at the status column (D) and depending on the column value, automatically move that whole row to a new sheet.

An example of my data is below

NameDate inputAmountStatus
John01/09/2016£0Awaiting Payment
Steve10/09/2016£0On hold
Andy11/09/2016£0Awaiting payment
Sam20/09/2016£1,000Complete
Sally10/10/2016£500Complete
Charlotte15/10/2016£0Cancelled

<colgroup><col span="4"></colgroup><tbody>
</tbody>


So I would like the code to look and the status column and sort the data as:

Where status = Complete - Move to Completed Sheet
Where Status = Awaiting Payment OR On hold - Move to Ongoing Sheet
Where Status = Cancelled - Move to Cancelled Sheet


Thanks in advance
Ben
 

Excel Facts

Add Bullets to Range
Select range. Press Ctrl+1. On Number tab, choose Custom. Type Alt+7 then space then @ sign (using 7 on numeric keypad)
Hi All, Looking for some help with a VBA code.

Each day I get a data download from one of our systems which compiles all completed, ongoing and cancelled cases.

I then have to manually go through the data to sort into 3 new sheets within the same workbook. With over 20,000 of data each day this can be quite mind numbing and slow.

I would like a code which will look at the status column (D) and depending on the column value, automatically move that whole row to a new sheet.

An example of my data is below

NameDate inputAmountStatus
John01/09/2016£0Awaiting Payment
Steve10/09/2016£0On hold
Andy11/09/2016£0Awaiting payment
Sam20/09/2016£1,000Complete
Sally10/10/2016£500Complete
Charlotte15/10/2016£0Cancelled

<colgroup><col span="4"></colgroup><tbody>
</tbody>


So I would like the code to look and the status column and sort the data as:

Where status = Complete - Move to Completed Sheet
Where Status = Awaiting Payment OR On hold - Move to Ongoing Sheet
Where Status = Cancelled - Move to Cancelled Sheet


Thanks in advance
Ben

try this

VERY IMPORTANT ****** Change the names of the worksheets to match your worksheets ****************

Code:
Sub Cases()

Dim lngrow As Long, lngcol As Long
Dim rngHEAD As Range, rngUSED As Range, rng As Range, cell As Range
Dim wsLIST As Worksheet, wsCOM As Worksheet, wsON As Worksheet, _
    wsCAN As Worksheet
Dim strSTATUS As String
Dim intSTA As Integer
Dim varI As Variant
Dim arrSTATUS() As Variant

    arrSTATUS = Array("Awaiting Payment", "On hold", "Complete", "Cancelled")
    strSTATUS = "Status"
    
'******************************************************************************
'       CHANGE THE NAMES OF THES FOUR WORKSHEETS TO MATCH YOUR SHEETS
'*******************************************************************************
    Set wsLIST = Sheets("List of cases")
    Set wsCOM = Sheets("Completed")
    Set wsON = Sheets("Ongoing")
    Set wsCAN = Sheets("Cancelled")
    
    With wsLIST
        lngrow = Range("A" & .Rows.Count).End(xlUp).Row
        lngcol = cells(1, .Columns.Count).End(xlToLeft).Column
        Set rngHEAD = Range(.cells(1, 1), .cells(1, lngcol))
        intSTA = rngHEAD.Find("Status").Column
        Set rngUSED = Range(.cells(2, 1), .cells(lngrow, lngcol))
        For Each varI In arrSTATUS
            .AutoFilterMode = False
            rngHEAD.AutoFilter field:=intSTA, Criteria1:=varI
            rngUSED.SpecialCells(xlCellTypeVisible).Copy
            Select Case varI
                Case "Complete"
                    wsCOM.Select
                    With wsCOM
                        lngrow = Range("A" & .Rows.Count).End(xlUp).Row
                        cells(lngrow + 1, 1).PasteSpecial xlPasteAll
                    End With
                Case "Cancelled"
                    wsCAN.Select
                    With wsCAN
                        lngrow = Range("A" & .Rows.Count).End(xlUp).Row
                        cells(lngrow + 1, 1).PasteSpecial xlPasteAll
                    End With
                Case Else
                    wsON.Select
                    With wsON
                        lngrow = Range("A" & .Rows.Count).End(xlUp).Row
                        cells(lngrow + 1, 1).PasteSpecial xlPasteAll
                    End With
            End Select
        Next varI
    End With
    wsLIST.AutoFilterMode = False
End Sub
 
Last edited:
Upvote 0
@RCBricker Thank you so much. That worked a treat! :)

Another question I have is if within my data I have test cases which need removing What code do I use for that? So using the below data, you will see in column A I have a couple of names as Test. I need a code which will identify where the name = test and delete the row, below using the previous code.

I am happy to set this up as another module so if you could provide a new code to identify where name = Test, then delete the row that would be awesome!

Thanks again.


NameDate inputAmountStatus
John01/09/2016£0Awaiting Payment
Steve10/09/2016£0On hold
Andy11/09/2016£0Awaiting payment
Sam20/09/2016£1,000Complete
Sally10/10/2016£500Complete
Charlotte

Test

Test
15/10/2016

01/01/1990

15/11/1950
£0

£0

£0
Cancelled

On Hold

On Hold


<tbody>
</tbody>
 
Upvote 0
this is the same code as before with a loop added to look for test instances, those are removed.

Code:
Sub Cases()

Dim lngrow As Long, lngcol As Long
Dim rngHEAD As Range, rngUSED As Range, rng As Range, cell As Range
Dim wsLIST As Worksheet, wsCOM As Worksheet, wsON As Worksheet, _
    wsCAN As Worksheet
Dim strSTATUS As String
Dim intSTA As Integer
Dim varI As Variant
Dim arrSTATUS() As Variant

    arrSTATUS = Array("Awaiting Payment", "On hold", "Complete", "Cancelled")
    strSTATUS = "Status"
    
'******************************************************************************
'       CHANGE THE NAMES OF THES FOUR WORKSHEETS TO MATCH YOUR SHEETS
'*******************************************************************************
    Set wsLIST = Sheets("List of cases")
    Set wsCOM = Sheets("Completed")
    Set wsON = Sheets("Ongoing")
    Set wsCAN = Sheets("Cancelled")
    
    With wsLIST
    
        lngrow = Range("A" & wsLIST.Rows.Count).End(xlUp).Row
        Set rngHEAD = wsLIST.Range(wsLIST.cells(2, 1), wsLIST.cells(lngrow, 1))
        
        For Each varI In rngHEAD
            If varI.Value = "Test" Or varI.Value = "test" Then
                varI.EntireRow.Delete
            End If
        Next varI
        
        lngrow = Range("A" & .Rows.Count).End(xlUp).Row
        lngcol = cells(1, .Columns.Count).End(xlToLeft).Column
        Set rngHEAD = Range(.cells(1, 1), .cells(1, lngcol))
        intSTA = rngHEAD.Find("Status").Column
        Set rngUSED = Range(.cells(2, 1), .cells(lngrow, lngcol))
        For Each varI In arrSTATUS
            .AutoFilterMode = False
            rngHEAD.AutoFilter field:=intSTA, Criteria1:=varI
            rngUSED.SpecialCells(xlCellTypeVisible).Copy
            Select Case varI
                Case "Complete"
                    wsCOM.Select
                    With wsCOM
                        lngrow = Range("A" & .Rows.Count).End(xlUp).Row
                        cells(lngrow + 1, 1).PasteSpecial xlPasteAll
                    End With
                Case "Cancelled"
                    wsCAN.Select
                    With wsCAN
                        lngrow = Range("A" & .Rows.Count).End(xlUp).Row
                        cells(lngrow + 1, 1).PasteSpecial xlPasteAll
                    End With
                Case Else
                    wsON.Select
                    With wsON
                        lngrow = Range("A" & .Rows.Count).End(xlUp).Row
                        cells(lngrow + 1, 1).PasteSpecial xlPasteAll
                    End With
            End Select
        Next varI
    End With
    wsLIST.AutoFilterMode = False
End Sub
 
Upvote 0

Forum statistics

Threads
1,213,483
Messages
6,113,919
Members
448,533
Latest member
thietbibeboiwasaco

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