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
 

Some videos you may like

Excel Facts

Excel Wisdom
Using a mouse in Excel is the work equivalent of wearing a lanyard when you first get to college

RCBricker

Well-known Member
Joined
Feb 4, 2003
Messages
1,560
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:

ManxBen

New Member
Joined
Nov 15, 2016
Messages
3
@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>
 

RCBricker

Well-known Member
Joined
Feb 4, 2003
Messages
1,560
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
 

Watch MrExcel Video

Forum statistics

Threads
1,108,701
Messages
5,524,409
Members
409,575
Latest member
navarrov74

This Week's Hot Topics

Top