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

M

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

[TABLE="width: 492"]
<colgroup><col span="4"></colgroup><tbody>[TR]
[TD="align: center"]Name[/TD]
[TD="align: center"]Date input[/TD]
[TD="align: center"]Amount[/TD]
[TD="align: center"]Status[/TD]
[/TR]
[TR]
[TD="align: center"]John[/TD]
[TD="align: center"]01/09/2016[/TD]
[TD="align: center"]£0[/TD]
[TD="align: center"]Awaiting Payment[/TD]
[/TR]
[TR]
[TD="align: center"]Steve[/TD]
[TD="align: center"]10/09/2016[/TD]
[TD="align: center"]£0[/TD]
[TD="align: center"]On hold[/TD]
[/TR]
[TR]
[TD="align: center"]Andy[/TD]
[TD="align: center"]11/09/2016[/TD]
[TD="align: center"]£0[/TD]
[TD="align: center"]Awaiting payment[/TD]
[/TR]
[TR]
[TD="align: center"]Sam[/TD]
[TD="align: center"]20/09/2016[/TD]
[TD="align: center"]£1,000[/TD]
[TD="align: center"]Complete[/TD]
[/TR]
[TR]
[TD="align: center"]Sally[/TD]
[TD="align: center"]10/10/2016[/TD]
[TD="align: center"]£500[/TD]
[TD="align: center"]Complete[/TD]
[/TR]
[TR]
[TD="align: center"]Charlotte[/TD]
[TD="align: center"]15/10/2016[/TD]
[TD="align: center"]£0[/TD]
[TD="align: center"]Cancelled[/TD]
[/TR]
</tbody>[/TABLE]


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
 
Sort by date Sort by votes
ManxBen said:
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

[TABLE="width: 492"]
<colgroup><col span="4"></colgroup><tbody>[TR]
[TD="align: center"]Name[/TD]
[TD="align: center"]Date input[/TD]
[TD="align: center"]Amount[/TD]
[TD="align: center"]Status[/TD]
[/TR]
[TR]
[TD="align: center"]John[/TD]
[TD="align: center"]01/09/2016[/TD]
[TD="align: center"]£0[/TD]
[TD="align: center"]Awaiting Payment[/TD]
[/TR]
[TR]
[TD="align: center"]Steve[/TD]
[TD="align: center"]10/09/2016[/TD]
[TD="align: center"]£0[/TD]
[TD="align: center"]On hold[/TD]
[/TR]
[TR]
[TD="align: center"]Andy[/TD]
[TD="align: center"]11/09/2016[/TD]
[TD="align: center"]£0[/TD]
[TD="align: center"]Awaiting payment[/TD]
[/TR]
[TR]
[TD="align: center"]Sam[/TD]
[TD="align: center"]20/09/2016[/TD]
[TD="align: center"]£1,000[/TD]
[TD="align: center"]Complete[/TD]
[/TR]
[TR]
[TD="align: center"]Sally[/TD]
[TD="align: center"]10/10/2016[/TD]
[TD="align: center"]£500[/TD]
[TD="align: center"]Complete[/TD]
[/TR]
[TR]
[TD="align: center"]Charlotte[/TD]
[TD="align: center"]15/10/2016[/TD]
[TD="align: center"]£0[/TD]
[TD="align: center"]Cancelled[/TD]
[/TR]
</tbody>[/TABLE]


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
Click to expand...

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.


[TABLE="class: cms_table, width: 492"]
<tbody>[TR]
[TD="align: center"]Name[/TD]
[TD="align: center"]Date input[/TD]
[TD="align: center"]Amount[/TD]
[TD="align: center"]Status[/TD]
[/TR]
[TR]
[TD="align: center"]John[/TD]
[TD="align: center"]01/09/2016[/TD]
[TD="align: center"]£0[/TD]
[TD="align: center"]Awaiting Payment[/TD]
[/TR]
[TR]
[TD="align: center"]Steve[/TD]
[TD="align: center"]10/09/2016[/TD]
[TD="align: center"]£0[/TD]
[TD="align: center"]On hold[/TD]
[/TR]
[TR]
[TD="align: center"]Andy[/TD]
[TD="align: center"]11/09/2016[/TD]
[TD="align: center"]£0[/TD]
[TD="align: center"]Awaiting payment[/TD]
[/TR]
[TR]
[TD="align: center"]Sam[/TD]
[TD="align: center"]20/09/2016[/TD]
[TD="align: center"]£1,000[/TD]
[TD="align: center"]Complete[/TD]
[/TR]
[TR]
[TD="align: center"]Sally[/TD]
[TD="align: center"]10/10/2016[/TD]
[TD="align: center"]£500[/TD]
[TD="align: center"]Complete[/TD]
[/TR]
[TR]
[TD="align: center"]Charlotte

Test

Test[/TD]
[TD="align: center"]15/10/2016

01/01/1990

15/11/1950[/TD]
[TD="align: center"]£0

£0

£0[/TD]
[TD="align: center"]Cancelled

On Hold

On Hold

[/TD]
[/TR]
</tbody>[/TABLE]
 
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
You must log in or register to reply here.

Similar threads

I
  • Solved
VBA Automatic Row Movement With Several Criteria
2
Replies
11
Views
973
Joe4
Joe4
L
  • Question Question
VBA Move Row by Cell Data
Replies
8
Views
420
Joe4
Joe4
L
  • Solved
Attempting importing sheet from data file into destination file.
2
Replies
16
Views
346
Alex Blakenburg
A
A
  • Question Question
Macro to move certain columns to new sheet based on status (ie; "done")
2
Replies
10
Views
913
AnnyCav
A
M
  • Question Question
Extract files from a specific location and add them as sheets to existing Excel file using macro button
Replies
2
Views
200
Mazurofgod
M

Share this page

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