VBA to move rows to another sheet based on criteria

JSR1306

New Member
Joined
Sep 15, 2012
Messages
45
Hi all,

I am sorry if this has been explained already but I cant find anything that quite does what I want.

Basically I have a table as follows with about 1000 lines of data.

ReferencePrioritystatusdescriptiondue datedate submitted
1232Openabc01/03/1311/02/13
1342Openjhg02/03/1311/02/13
1241AWC kli01/03/1311/02/13
3213AWCijk01/03/1311/02/13
5264Escalatedyhu02/03/1311/02/13
9814Escalatedjhy01/03/1311/02/13
8522Openabd01/03/1311/02/13

<tbody>
</tbody>

Basically I want to sort these into separate sheets under the headings of the status column. I have tried writing macros however this is very messy and I am sure there is a better way of coding it.

I have also tried some code such as the following:

Sub go()


Dim StsCol As String


Sheets("Report").Select


StsCol = Application.Range("A1000").End(xlUp).Row


a = 1




For i = 1 To StsCol

Sheets("Report").Select
If Range("C" & i).Value = "Open" Then
Range("C" & i).EntireRow.Copy
Sheets("T1 Open").Select
ActiveSheet.Range("A" & a).Select
Selection.PasteSpecial (xlValues)
a = a + 1
End If
Next

MsgBox "Done!"


End Sub


This does work on sorting the Open into a separate sheet, however, it is very slow and you the screen just blinks rapidly as it finds a row with Open and copies, then pastes it to the correct sheet.

I am not great a VB so any help is greatly appreciated. Hopefully I will learn something in the process :)

Many Thanks

John
 

Some videos you may like

Excel Facts

Do you hate GETPIVOTDATA?
Prevent GETPIVOTDATA. Select inside a PivotTable. In the Analyze tab of the ribbon, open the dropown next to Options and turn it off

erik.van.geit

MrExcel MVP
Joined
Feb 1, 2003
Messages
17,832
Hi,

This tempted me :)
Try this code
Code:
Sub FilterToSheets()
'Erik Van Geit
'1302013 2118
'lacks error handling when sheet doesn't exist
'clearing sheets and pasting with columnheaders
Dim SourceSheet As Worksheet
Dim TargetSheet As Worksheet
Dim SheetNames As Variant
Dim i As Long
Dim LR As Long

'EDIT
Set SourceSheet = Sheets("WhatEverName")
SheetNames = Array("Open", "AWC", "Escalated")
Const FilterColumn = 3
'END EDIT

    With SourceSheet
    LR = .Range("A" & .Rows.Count).End(xlUp).Row
    
        For i = 0 To UBound(SheetNames)
        Set TargetSheet = Worksheets(SheetNames(i))
        TargetSheet.Cells.ClearContents
        
            With .Range("A1:F" & LR)
            .AutoFilter Field:=FilterColumn, Criteria1:=SheetNames(i)
            .Offset(0, 0).Copy TargetSheet.Range("A1")
            End With
        Next i

    End With

End Sub
kind regards,
Erik
 

texasalynn

Well-known Member
Joined
May 19, 2002
Messages
8,458
this is a macro I use to breakout data based on what is in column A and the sheet name is "ALL". With some slight modifications this could work

Code:
Sub breakout()
Workbooks(1).Activate
Dim lastCol As Integer, LastRow As Long, x As Long
Dim rng As Range, Rng1 As Range, Rng2 As Range, Rng3 As Range
Dim SheetNameArray, fn As WorksheetFunction
Dim CalcSetting As Integer
Dim newsht As Worksheet
Set fn = Application.WorksheetFunction
 
With Application
    CalcSetting = .Calculation
    .Calculation = xlCalculationManual
    .ScreenUpdating = False
End With
 
With Sheets("All")
    Set rng = .UsedRange
    Set Rng1 = Intersect(rng, .Range("A:A"))
    lastCol = rng.Column + rng.Columns.Count - 1
 
    .Range("A:A").AdvancedFilter Action:=xlFilterCopy, _
    CopyToRange:=.Cells(1, lastCol + 2), Unique:=True
 
    Set Rng2 = Intersect(.Columns(lastCol + 2).CurrentRegion, _
    .Rows("2:" & Rows.Count))
 
    ReDim SheetNameArray(1 To Rng2.Cells.Count)
    SheetNameArray = fn.Transpose(Rng2)
    .Columns(lastCol + 2).Clear
 
    For x = LBound(SheetNameArray) To UBound(SheetNameArray)
        On Error Resume Next
        Set newsht = ThisWorkbook.Sheets(CStr(SheetNameArray(x)))
            If Err <> 0 Then
                Worksheets.Add
                ActiveSheet.Name = CStr(SheetNameArray(x))
                Err.Clear
            End If
        On Error GoTo 0
            rng.AutoFilter Field:=1, Criteria1:=SheetNameArray(x)
            Set Rng3 = Intersect(rng, .Cells.SpecialCells(xlCellTypeVisible))
            Rng3.Copy Workbooks(1).Sheets(CStr(SheetNameArray(x))).Range("A1")
            rng.AutoFilter
     Next x
End With
Range("A1").Select
Application.Calculation = CalcSetting
 
End Sub
 

JSR1306

New Member
Joined
Sep 15, 2012
Messages
45
Thanks Erik,

I made a few tweaks for my actual data and it works instantly, much better than the route I was going down :)

Many Thanks

John
 

erik.van.geit

MrExcel MVP
Joined
Feb 1, 2003
Messages
17,832
You're welcome!

See if you can keep the macro recorder as your friend and then go beyond: get rid of all kinds of "select", use filter instead of loop, etcetera...
If you want to add sheets during code, in case there are new criteria, take a look at texasalynns code.

best regards,
Erik
 

hiker95

Well-known Member
Joined
Apr 8, 2009
Messages
17,649
Jsr1306,


Sample raw data:


<b>Excel 2007</b><table cellpadding="2.5px" rules="all" style=";background-color: #FFFFFF;border: 1px solid;border-collapse: collapse; border-color: #A6AAB6"><colgroup><col width="25px" style="background-color: #E0E0F0" /><col /><col /><col /><col /><col /><col /></colgroup><thead><tr style=" background-color: #E0E0F0;text-align: center;color: #161120"><th></th><th>A</th><th>B</th><th>C</th><th>D</th><th>E</th><th>F</th></tr></thead><tbody><tr ><td style="color: #161120;text-align: center;">1</td><td style="border-top: 1px solid black;border-right: 1px solid black;border-bottom: 1px solid black;border-left: 1px solid black;color: #574123;background-color: #FFFFFF;;">Reference</td><td style="border-top: 1px solid black;border-right: 1px solid black;border-bottom: 1px solid black;border-left: 1px solid black;color: #574123;background-color: #FFFFFF;;">Priority</td><td style="border-top: 1px solid black;border-right: 1px solid black;border-bottom: 1px solid black;border-left: 1px solid black;color: #574123;background-color: #FFFFFF;;">status</td><td style="border-top: 1px solid black;border-right: 1px solid black;border-bottom: 1px solid black;border-left: 1px solid black;color: #574123;background-color: #FFFFFF;;">description</td><td style="border-top: 1px solid black;border-right: 1px solid black;border-bottom: 1px solid black;border-left: 1px solid black;color: #574123;background-color: #FFFFFF;;">due date</td><td style="border-top: 1px solid black;border-right: 1px solid black;border-bottom: 1px solid black;border-left: 1px solid black;color: #574123;background-color: #FFFFFF;;">date submitted</td></tr><tr ><td style="color: #161120;text-align: center;">2</td><td style="text-align: right;border-top: 1px solid black;border-right: 1px solid black;border-bottom: 1px solid black;border-left: 1px solid black;color: #574123;background-color: #FFFFFF;;">123</td><td style="text-align: right;border-top: 1px solid black;border-right: 1px solid black;border-bottom: 1px solid black;border-left: 1px solid black;color: #574123;background-color: #FFFFFF;;">2</td><td style="border-top: 1px solid black;border-right: 1px solid black;border-bottom: 1px solid black;border-left: 1px solid black;color: #574123;background-color: #FFFFFF;;">Open</td><td style="border-top: 1px solid black;border-right: 1px solid black;border-bottom: 1px solid black;border-left: 1px solid black;color: #574123;background-color: #FFFFFF;;">abc</td><td style="text-align: right;border-top: 1px solid black;border-right: 1px solid black;border-bottom: 1px solid black;border-left: 1px solid black;color: #574123;background-color: #FFFFFF;;">1/3/2013</td><td style="text-align: right;border-top: 1px solid black;border-right: 1px solid black;border-bottom: 1px solid black;border-left: 1px solid black;color: #574123;background-color: #FFFFFF;;">11/2/2013</td></tr><tr ><td style="color: #161120;text-align: center;">3</td><td style="text-align: right;border-top: 1px solid black;border-right: 1px solid black;border-bottom: 1px solid black;border-left: 1px solid black;color: #574123;background-color: #FFFFFF;;">134</td><td style="text-align: right;border-top: 1px solid black;border-right: 1px solid black;border-bottom: 1px solid black;border-left: 1px solid black;color: #574123;background-color: #FFFFFF;;">2</td><td style="border-top: 1px solid black;border-right: 1px solid black;border-bottom: 1px solid black;border-left: 1px solid black;color: #574123;background-color: #FFFFFF;;">Open</td><td style="border-top: 1px solid black;border-right: 1px solid black;border-bottom: 1px solid black;border-left: 1px solid black;color: #574123;background-color: #FFFFFF;;">jhg</td><td style="text-align: right;border-top: 1px solid black;border-right: 1px solid black;border-bottom: 1px solid black;border-left: 1px solid black;color: #574123;background-color: #FFFFFF;;">2/3/2013</td><td style="text-align: right;border-top: 1px solid black;border-right: 1px solid black;border-bottom: 1px solid black;border-left: 1px solid black;color: #574123;background-color: #FFFFFF;;">11/2/2013</td></tr><tr ><td style="color: #161120;text-align: center;">4</td><td style="text-align: right;border-top: 1px solid black;border-right: 1px solid black;border-bottom: 1px solid black;border-left: 1px solid black;color: #574123;background-color: #FFFFFF;;">124</td><td style="text-align: right;border-top: 1px solid black;border-right: 1px solid black;border-bottom: 1px solid black;border-left: 1px solid black;color: #574123;background-color: #FFFFFF;;">1</td><td style="border-top: 1px solid black;border-right: 1px solid black;border-bottom: 1px solid black;border-left: 1px solid black;color: #574123;background-color: #FFFFFF;;">AWC</td><td style="border-top: 1px solid black;border-right: 1px solid black;border-bottom: 1px solid black;border-left: 1px solid black;color: #574123;background-color: #FFFFFF;;">kli</td><td style="text-align: right;border-top: 1px solid black;border-right: 1px solid black;border-bottom: 1px solid black;border-left: 1px solid black;color: #574123;background-color: #FFFFFF;;">1/3/2013</td><td style="text-align: right;border-top: 1px solid black;border-right: 1px solid black;border-bottom: 1px solid black;border-left: 1px solid black;color: #574123;background-color: #FFFFFF;;">11/2/2013</td></tr><tr ><td style="color: #161120;text-align: center;">5</td><td style="text-align: right;border-top: 1px solid black;border-right: 1px solid black;border-bottom: 1px solid black;border-left: 1px solid black;color: #574123;background-color: #FFFFFF;;">321</td><td style="text-align: right;border-top: 1px solid black;border-right: 1px solid black;border-bottom: 1px solid black;border-left: 1px solid black;color: #574123;background-color: #FFFFFF;;">3</td><td style="border-top: 1px solid black;border-right: 1px solid black;border-bottom: 1px solid black;border-left: 1px solid black;color: #574123;background-color: #FFFFFF;;">AWC</td><td style="border-top: 1px solid black;border-right: 1px solid black;border-bottom: 1px solid black;border-left: 1px solid black;color: #574123;background-color: #FFFFFF;;">ijk</td><td style="text-align: right;border-top: 1px solid black;border-right: 1px solid black;border-bottom: 1px solid black;border-left: 1px solid black;color: #574123;background-color: #FFFFFF;;">1/3/2013</td><td style="text-align: right;border-top: 1px solid black;border-right: 1px solid black;border-bottom: 1px solid black;border-left: 1px solid black;color: #574123;background-color: #FFFFFF;;">11/2/2013</td></tr><tr ><td style="color: #161120;text-align: center;">6</td><td style="text-align: right;border-top: 1px solid black;border-right: 1px solid black;border-bottom: 1px solid black;border-left: 1px solid black;color: #574123;background-color: #FFFFFF;;">526</td><td style="text-align: right;border-top: 1px solid black;border-right: 1px solid black;border-bottom: 1px solid black;border-left: 1px solid black;color: #574123;background-color: #FFFFFF;;">4</td><td style="border-top: 1px solid black;border-right: 1px solid black;border-bottom: 1px solid black;border-left: 1px solid black;color: #574123;background-color: #FFFFFF;;">Escalated</td><td style="border-top: 1px solid black;border-right: 1px solid black;border-bottom: 1px solid black;border-left: 1px solid black;color: #574123;background-color: #FFFFFF;;">yhu</td><td style="text-align: right;border-top: 1px solid black;border-right: 1px solid black;border-bottom: 1px solid black;border-left: 1px solid black;color: #574123;background-color: #FFFFFF;;">2/3/2013</td><td style="text-align: right;border-top: 1px solid black;border-right: 1px solid black;border-bottom: 1px solid black;border-left: 1px solid black;color: #574123;background-color: #FFFFFF;;">11/2/2013</td></tr><tr ><td style="color: #161120;text-align: center;">7</td><td style="text-align: right;border-top: 1px solid black;border-right: 1px solid black;border-bottom: 1px solid black;border-left: 1px solid black;color: #574123;background-color: #FFFFFF;;">981</td><td style="text-align: right;border-top: 1px solid black;border-right: 1px solid black;border-bottom: 1px solid black;border-left: 1px solid black;color: #574123;background-color: #FFFFFF;;">4</td><td style="border-top: 1px solid black;border-right: 1px solid black;border-bottom: 1px solid black;border-left: 1px solid black;color: #574123;background-color: #FFFFFF;;">Escalated</td><td style="border-top: 1px solid black;border-right: 1px solid black;border-bottom: 1px solid black;border-left: 1px solid black;color: #574123;background-color: #FFFFFF;;">jhy</td><td style="text-align: right;border-top: 1px solid black;border-right: 1px solid black;border-bottom: 1px solid black;border-left: 1px solid black;color: #574123;background-color: #FFFFFF;;">1/3/2013</td><td style="text-align: right;border-top: 1px solid black;border-right: 1px solid black;border-bottom: 1px solid black;border-left: 1px solid black;color: #574123;background-color: #FFFFFF;;">11/2/2013</td></tr><tr ><td style="color: #161120;text-align: center;">8</td><td style="text-align: right;border-top: 1px solid black;border-right: 1px solid black;border-bottom: 1px solid black;border-left: 1px solid black;color: #574123;background-color: #FFFFFF;;">852</td><td style="text-align: right;border-top: 1px solid black;border-right: 1px solid black;border-bottom: 1px solid black;border-left: 1px solid black;color: #574123;background-color: #FFFFFF;;">2</td><td style="border-top: 1px solid black;border-right: 1px solid black;border-bottom: 1px solid black;border-left: 1px solid black;color: #574123;background-color: #FFFFFF;;">Open</td><td style="border-top: 1px solid black;border-right: 1px solid black;border-bottom: 1px solid black;border-left: 1px solid black;color: #574123;background-color: #FFFFFF;;">abd</td><td style="text-align: right;border-top: 1px solid black;border-right: 1px solid black;border-bottom: 1px solid black;border-left: 1px solid black;color: #574123;background-color: #FFFFFF;;">1/3/2013</td><td style="text-align: right;border-top: 1px solid black;border-right: 1px solid black;border-bottom: 1px solid black;border-left: 1px solid black;color: #574123;background-color: #FFFFFF;;">11/2/2013</td></tr><tr ><td style="color: #161120;text-align: center;">9</td><td style="text-align: right;border-top: 1px solid black;border-right: 1px solid black;border-bottom: 1px solid black;border-left: 1px solid black;;"></td><td style="text-align: right;border-top: 1px solid black;border-right: 1px solid black;border-bottom: 1px solid black;border-left: 1px solid black;;"></td><td style="text-align: right;border-top: 1px solid black;border-right: 1px solid black;border-bottom: 1px solid black;border-left: 1px solid black;;"></td><td style="text-align: right;border-top: 1px solid black;border-right: 1px solid black;border-bottom: 1px solid black;border-left: 1px solid black;;"></td><td style="text-align: right;border-top: 1px solid black;border-right: 1px solid black;border-bottom: 1px solid black;border-left: 1px solid black;;"></td><td style="text-align: right;border-top: 1px solid black;border-right: 1px solid black;border-bottom: 1px solid black;border-left: 1px solid black;;"></td></tr></tbody></table><p style="width:3.6em;font-weight:bold;margin:0;padding:0.2em 0.6em 0.2em 0.5em;border: 1px solid #A6AAB6;border-top:none;text-align: center;background-color: #E0E0F0;color: #161120">Report</p><br /><br />




After the macro (the three additional worksheets must already exist):


<b>Excel 2007</b><table cellpadding="2.5px" rules="all" style=";background-color: #FFFFFF;border: 1px solid;border-collapse: collapse; border-color: #A6AAB6"><colgroup><col width="25px" style="background-color: #E0E0F0" /><col /><col /><col /><col /><col /><col /></colgroup><thead><tr style=" background-color: #E0E0F0;text-align: center;color: #161120"><th></th><th>A</th><th>B</th><th>C</th><th>D</th><th>E</th><th>F</th></tr></thead><tbody><tr ><td style="color: #161120;text-align: center;">1</td><td style="border-top: 1px solid black;border-right: 1px solid black;border-bottom: 1px solid black;border-left: 1px solid black;color: #574123;background-color: #FFFFFF;;">Reference</td><td style="border-top: 1px solid black;border-right: 1px solid black;border-bottom: 1px solid black;border-left: 1px solid black;color: #574123;background-color: #FFFFFF;;">Priority</td><td style="border-top: 1px solid black;border-right: 1px solid black;border-bottom: 1px solid black;border-left: 1px solid black;color: #574123;background-color: #FFFFFF;;">status</td><td style="border-top: 1px solid black;border-right: 1px solid black;border-bottom: 1px solid black;border-left: 1px solid black;color: #574123;background-color: #FFFFFF;;">description</td><td style="border-top: 1px solid black;border-right: 1px solid black;border-bottom: 1px solid black;border-left: 1px solid black;color: #574123;background-color: #FFFFFF;;">due date</td><td style="border-top: 1px solid black;border-right: 1px solid black;border-bottom: 1px solid black;border-left: 1px solid black;color: #574123;background-color: #FFFFFF;;">date submitted</td></tr><tr ><td style="color: #161120;text-align: center;">2</td><td style="text-align: right;border-top: 1px solid black;;">123</td><td style="text-align: right;border-top: 1px solid black;;">2</td><td style="border-top: 1px solid black;;">Open</td><td style="border-top: 1px solid black;;">abc</td><td style="text-align: right;border-top: 1px solid black;;">1/3/2013</td><td style="text-align: right;border-top: 1px solid black;;">11/2/2013</td></tr><tr ><td style="color: #161120;text-align: center;">3</td><td style="text-align: right;;">134</td><td style="text-align: right;;">2</td><td style=";">Open</td><td style=";">jhg</td><td style="text-align: right;;">2/3/2013</td><td style="text-align: right;;">11/2/2013</td></tr><tr ><td style="color: #161120;text-align: center;">4</td><td style="text-align: right;;">852</td><td style="text-align: right;;">2</td><td style=";">Open</td><td style=";">abd</td><td style="text-align: right;;">1/3/2013</td><td style="text-align: right;;">11/2/2013</td></tr><tr ><td style="color: #161120;text-align: center;">5</td><td style="text-align: right;;"></td><td style="text-align: right;;"></td><td style="text-align: right;;"></td><td style="text-align: right;;"></td><td style="text-align: right;;"></td><td style="text-align: right;;"></td></tr></tbody></table><p style="width:2.4em;font-weight:bold;margin:0;padding:0.2em 0.6em 0.2em 0.5em;border: 1px solid #A6AAB6;border-top:none;text-align: center;background-color: #E0E0F0;color: #161120">Open</p><br /><br />



<b>Excel 2007</b><table cellpadding="2.5px" rules="all" style=";background-color: #FFFFFF;border: 1px solid;border-collapse: collapse; border-color: #A6AAB6"><colgroup><col width="25px" style="background-color: #E0E0F0" /><col /><col /><col /><col /><col /><col /></colgroup><thead><tr style=" background-color: #E0E0F0;text-align: center;color: #161120"><th></th><th>A</th><th>B</th><th>C</th><th>D</th><th>E</th><th>F</th></tr></thead><tbody><tr ><td style="color: #161120;text-align: center;">1</td><td style="border-top: 1px solid black;border-right: 1px solid black;border-bottom: 1px solid black;border-left: 1px solid black;color: #574123;background-color: #FFFFFF;;">Reference</td><td style="border-top: 1px solid black;border-right: 1px solid black;border-bottom: 1px solid black;border-left: 1px solid black;color: #574123;background-color: #FFFFFF;;">Priority</td><td style="border-top: 1px solid black;border-right: 1px solid black;border-bottom: 1px solid black;border-left: 1px solid black;color: #574123;background-color: #FFFFFF;;">status</td><td style="border-top: 1px solid black;border-right: 1px solid black;border-bottom: 1px solid black;border-left: 1px solid black;color: #574123;background-color: #FFFFFF;;">description</td><td style="border-top: 1px solid black;border-right: 1px solid black;border-bottom: 1px solid black;border-left: 1px solid black;color: #574123;background-color: #FFFFFF;;">due date</td><td style="border-top: 1px solid black;border-right: 1px solid black;border-bottom: 1px solid black;border-left: 1px solid black;color: #574123;background-color: #FFFFFF;;">date submitted</td></tr><tr ><td style="color: #161120;text-align: center;">2</td><td style="text-align: right;border-top: 1px solid black;;">124</td><td style="text-align: right;border-top: 1px solid black;;">1</td><td style="border-top: 1px solid black;;">AWC</td><td style="border-top: 1px solid black;;">kli</td><td style="text-align: right;border-top: 1px solid black;;">1/3/2013</td><td style="text-align: right;border-top: 1px solid black;;">11/2/2013</td></tr><tr ><td style="color: #161120;text-align: center;">3</td><td style="text-align: right;;">321</td><td style="text-align: right;;">3</td><td style=";">AWC</td><td style=";">ijk</td><td style="text-align: right;;">1/3/2013</td><td style="text-align: right;;">11/2/2013</td></tr><tr ><td style="color: #161120;text-align: center;">4</td><td style="text-align: right;;"></td><td style="text-align: right;;"></td><td style="text-align: right;;"></td><td style="text-align: right;;"></td><td style="text-align: right;;"></td><td style="text-align: right;;"></td></tr></tbody></table><p style="width:1.8em;font-weight:bold;margin:0;padding:0.2em 0.6em 0.2em 0.5em;border: 1px solid #A6AAB6;border-top:none;text-align: center;background-color: #E0E0F0;color: #161120">AWC</p><br /><br />



<b>Excel 2007</b><table cellpadding="2.5px" rules="all" style=";background-color: #FFFFFF;border: 1px solid;border-collapse: collapse; border-color: #A6AAB6"><colgroup><col width="25px" style="background-color: #E0E0F0" /><col /><col /><col /><col /><col /><col /></colgroup><thead><tr style=" background-color: #E0E0F0;text-align: center;color: #161120"><th></th><th>A</th><th>B</th><th>C</th><th>D</th><th>E</th><th>F</th></tr></thead><tbody><tr ><td style="color: #161120;text-align: center;">1</td><td style="border-top: 1px solid black;border-right: 1px solid black;border-bottom: 1px solid black;border-left: 1px solid black;color: #574123;background-color: #FFFFFF;;">Reference</td><td style="border-top: 1px solid black;border-right: 1px solid black;border-bottom: 1px solid black;border-left: 1px solid black;color: #574123;background-color: #FFFFFF;;">Priority</td><td style="border-top: 1px solid black;border-right: 1px solid black;border-bottom: 1px solid black;border-left: 1px solid black;color: #574123;background-color: #FFFFFF;;">status</td><td style="border-top: 1px solid black;border-right: 1px solid black;border-bottom: 1px solid black;border-left: 1px solid black;color: #574123;background-color: #FFFFFF;;">description</td><td style="border-top: 1px solid black;border-right: 1px solid black;border-bottom: 1px solid black;border-left: 1px solid black;color: #574123;background-color: #FFFFFF;;">due date</td><td style="border-top: 1px solid black;border-right: 1px solid black;border-bottom: 1px solid black;border-left: 1px solid black;color: #574123;background-color: #FFFFFF;;">date submitted</td></tr><tr ><td style="color: #161120;text-align: center;">2</td><td style="text-align: right;border-top: 1px solid black;;">526</td><td style="text-align: right;border-top: 1px solid black;;">4</td><td style="border-top: 1px solid black;;">Escalated</td><td style="border-top: 1px solid black;;">yhu</td><td style="text-align: right;border-top: 1px solid black;;">2/3/2013</td><td style="text-align: right;border-top: 1px solid black;;">11/2/2013</td></tr><tr ><td style="color: #161120;text-align: center;">3</td><td style="text-align: right;;">981</td><td style="text-align: right;;">4</td><td style=";">Escalated</td><td style=";">jhy</td><td style="text-align: right;;">1/3/2013</td><td style="text-align: right;;">11/2/2013</td></tr><tr ><td style="color: #161120;text-align: center;">4</td><td style="text-align: right;;"></td><td style="text-align: right;;"></td><td style="text-align: right;;"></td><td style="text-align: right;;"></td><td style="text-align: right;;"></td><td style="text-align: right;;"></td></tr></tbody></table><p style="width:5.4em;font-weight:bold;margin:0;padding:0.2em 0.6em 0.2em 0.5em;border: 1px solid #A6AAB6;border-top:none;text-align: center;background-color: #E0E0F0;color: #161120">Escalated</p><br /><br />
 

hiker95

Well-known Member
Joined
Apr 8, 2009
Messages
17,649
Jsr1306,


Please TEST this FIRST in a COPY of your workbook (always make a backup copy before trying new code, you never know what you might lose).


Code:
Option Explicit
Sub DistributeRows()
' hiker95, 02/13/2013
' http://www.mrexcel.com/forum/excel-questions/685493-visual-basic-applications-move-rows-another-sheet-based-criteria.html
' The original code by MickG, 12/20/2012, has been modified.
Dim d As Range, Rng As Range, It As Range, nr As Long, k
Application.ScreenUpdating = False
Set Rng = Sheets("Report").Range(Range("C2"), Range("C" & Rows.Count).End(xlUp))
With CreateObject("Scripting.Dictionary")
  .CompareMode = vbTextCompare
  For Each d In Rng
    If Not .Exists(d.Value) Then
      .Add d.Value, d.EntireRow
    Else
      Set .Item(d.Value) = Union(.Item(d.Value), d.EntireRow)
    End If
  Next
  For Each k In .keys
    For Each It In .Item(k).Areas
      nr = Sheets(k).Range("A" & Rows.Count).End(xlUp).Offset(1).Row
      Sheets(k).Range("A" & nr).Resize(It.Rows.Count, ActiveSheet.Columns.Count) = It.Value
    Next It
  Next k
End With
Application.ScreenUpdating = False
End Sub

Before you use the macro with Excel 2007 or newer, save your workbook, Save As, a macro enabled workbook with the file extension .xlsm


Then run the DistributeRows macro (very fast).
 
Last edited:

Brian R Armstrong

Board Regular
Joined
Jun 5, 2007
Messages
87
Can the Sub DistributeRows() macro be adapted to run using the "Worksheet_Change(ByVal Target As Range)" i.e. update the status on the relevant sheet automatically?

I have been struggling with this for ages

Appreciate any help

Brian A
 

Brian R Armstrong

Board Regular
Joined
Jun 5, 2007
Messages
87
Can the Sub DistributeRows() macro be adapted to run using the "Worksheet_Change(ByVal Target As Range)" i.e. update the status on the relevant sheet automatically?

I have been struggling with this for ages

Appreciate any help

Brian A
 

Watch MrExcel Video

Forum statistics

Threads
1,095,870
Messages
5,446,984
Members
405,425
Latest member
Hackoo

This Week's Hot Topics

Top