Macro to copy rows that contain certain value into new worksheet

S

shizalot

New Member
Joined
Feb 10, 2015
Messages
5
Hello and thank you in advance...I have a large spreadsheet that is exported from an application. I need to have a macro that will find all rows for each state and copy the row into a new worksheet labeled by each state and delete the rows that it copied. I would like to do this automatically. It might be thousands of rows per state and many columns and my goal is to group them all together in its own worksheet with column headers and all with one button click.

Can anyone help me?


[TABLE="width: 500"]

<tbody>[TR]
[TD]State[/TD]
[TD]Column2[/TD]
[TD]Column3..and so on[/TD]
[/TR]
[TR]
[TD]VA[/TD]
[TD]100[/TD]
[TD]rice[/TD]
[/TR]
[TR]
[TD]NC[/TD]
[TD]201[/TD]
[TD]twix[/TD]
[/TR]
[TR]
[TD]KY[/TD]
[TD]301[/TD]
[TD]basketball[/TD]
[/TR]
</tbody>
[/TABLE]
 
Sort by date Sort by votes
Code: 
Sub stateTabs()    
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    
    nextRow = 2


    With Sheets(1)
        For x = 2 To .Cells(Rows.Count, 1).End(xlUp).Row Step 1
            If .Cells(x, 1) <> "" Then
                stateCheck = .Cells(x, 1)
                .Cells(x, 1) = ""
                Sheets.Add After:=Sheets(Sheets.Count)
                ActiveSheet.Name = stateCheck
                Sheets(stateCheck).Cells(1, 1).EntireRow.Value = .Cells(1, 1).EntireRow.Value
                
                For y = x + 1 To .Cells(Rows.Count, 1).End(xlUp).Row Step 1
                    If .Cells(y, 1) = stateCheck Then
                        Sheets(stateCheck).Cells(nextRow, 1).EntireRow.Value = .Cells(y, 1).EntireRow.Value
                        .Cells(y, 1) = ""
                        nextRow = nextRow + 1
                    End If
                Next y
            End If
            nextRow = 2
        Next x
    End With


    Application.ScreenUpdating = True
    Application.EnableEvents = True


End Sub

This assumes your data is in the first AND ONLY sheet of the workbook. It won't completely delete the first sheet, but that's an easy fix. SAVE FIRST AND THEN TEST THIS MACRO AS IT WILL DELETE DATA.
 
Upvote 0
Try:
Code: 
Sub CopyRows()
    Application.ScreenUpdating = False
    Dim LastRow As Long
    LastRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    Dim ws As Worksheet
    Dim state As Range
    Dim rngUniques As Range
    Sheets("Sheet1").Range("A1:A" & LastRow).AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:=Range _
        ("A1:A" & LastRow), Unique:=True
    Set rngUniques = Sheets("Sheet1").Range("A2:A" & LastRow).SpecialCells(xlCellTypeVisible)
    If Sheets("Sheet1").FilterMode Then ActiveSheet.ShowAllData
    For Each state In rngUniques
        Sheets("Sheet1").Range("$A$1:$A$" & LastRow).AutoFilter Field:=1, Criteria1:=state
        Set ws = Nothing
        On Error Resume Next
        Set ws = Worksheets(state.Value)
        On Error GoTo 0
        If ws Is Nothing Then
                Worksheets.Add(After:=Sheets(Sheets.Count)).Name = state.Value
                Sheets("Sheet1").Range("A2:A" & LastRow).SpecialCells(xlCellTypeVisible).EntireRow.Copy ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
                Sheets("Sheet1").Range("A2:A" & LastRow).SpecialCells(xlCellTypeVisible).EntireRow.Delete
                If Sheets("Sheet1").FilterMode Then Sheets("Sheet1").ShowAllData
        End If
    Next state
    Application.ScreenUpdating = True
End Sub
 
Upvote 0
My apologies. I had to make a minor change. Please try this code:
Code: 
Sub CopyRows()
    Application.ScreenUpdating = False
    Dim LastRow As Long
    LastRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    Dim ws As Worksheet
    Dim state As Range
    Dim rngUniques As Range
    Sheets("Sheet1").Range("A1:A" & LastRow).AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:=Range _
        ("A1:A" & LastRow), Unique:=True
    Set rngUniques = Sheets("Sheet1").Range("A2:A" & LastRow).SpecialCells(xlCellTypeVisible)
    If Sheets("Sheet1").FilterMode Then Sheets("Sheet1").ShowAllData
    For Each state In rngUniques
        Sheets("Sheet1").Range("$A$1:$A$" & LastRow).AutoFilter Field:=1, Criteria1:=state
        Set ws = Nothing
        On Error Resume Next
        Set ws = Worksheets(state.Value)
        On Error GoTo 0
        If ws Is Nothing Then
                Worksheets.Add(After:=Sheets(Sheets.Count)).Name = state.Value
                Sheets("Sheet1").Range("A2:A" & LastRow).SpecialCells(xlCellTypeVisible).EntireRow.Copy ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
                If Sheets("Sheet1").FilterMode Then Sheets("Sheet1").ShowAllData
        End If
    Next state
    Sheets("Sheet1").UsedRange.Offset(1, 0).ClearContents
    Application.ScreenUpdating = True
End Sub
 
Upvote 0
Thank you for your response, but this did not work completely...

For example...I began with this...

State Column1 Column2
VA 21 Dog
VA 31 Cat
VA 41 Dog
VA 51 Cat
VA 61 Dog
VA 71 Cat
VA 81 Dog
NC 91 Cat

I ran the code and it created the two state worksheets and labeled them correctly...one for VA and one for NC, but it did not copy the NC row to the NC tab and it only copied some of the rows for VA. Also it did not delete all rows that it moved here are the results of what I ran below:

Sheet 1 - It only deleted the state cell values instead of all rows that it moved
State Column1 Column2
21 Dog
31 Cat
41 Dog
51 Cat
61 Dog
71 Cat
81 Dog
91 Cat

VA Tab - Its missing the first and last VA rows...see the starting table for comparison
[TABLE="width: 144"]


<colgroup><col style="width: 48pt;" span="3" width="64">
<tbody>[TR]

[TD="width: 64, bgcolor: transparent"]State[/TD]

[TD="width: 64, bgcolor: transparent"]Column1[/TD]

[TD="width: 64, bgcolor: transparent"]Column2[/TD]

[/TR]

[TR]

[TD="bgcolor: transparent"]VA[/TD]

[TD="bgcolor: transparent, align: right"]31[/TD]

[TD="bgcolor: transparent"]Cat[/TD]

[/TR]

[TR]

[TD="bgcolor: transparent"]VA[/TD]

[TD="bgcolor: transparent, align: right"]41[/TD]

[TD="bgcolor: transparent"]Dog[/TD]

[/TR]

[TR]

[TD="bgcolor: transparent"]VA[/TD]

[TD="bgcolor: transparent, align: right"]51[/TD]

[TD="bgcolor: transparent"]Cat[/TD]

[/TR]

[TR]

[TD="bgcolor: transparent"]VA[/TD]

[TD="bgcolor: transparent, align: right"]61[/TD]

[TD="bgcolor: transparent"]Dog[/TD]

[/TR]

[TR]

[TD="bgcolor: transparent"]VA[/TD]

[TD="bgcolor: transparent, align: right"]71[/TD]

[TD="bgcolor: transparent"]Cat[/TD]

[/TR]

[TR]

[TD="bgcolor: transparent"]VA[/TD]

[TD="bgcolor: transparent, align: right"]81[/TD]

[TD="bgcolor: transparent"]Dog[/TD]

[/TR]


</tbody>[/TABLE]

NC Tab - It didnt copy the NC row at all as the table was blank
[TABLE="width: 144"]

<colgroup><col style="width: 48pt;" span="3" width="64">
<tbody>[TR]


[TD="width: 64, bgcolor: transparent"]State[/TD]

[TD="width: 64, bgcolor: transparent"]Column1[/TD]

[TD="width: 64, bgcolor: transparent"]Column2[/TD]


[/TR]

</tbody>[/TABLE]


Please help.

NeonRedSharpie said:
Code: 
Sub stateTabs()    
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    
    nextRow = 2


    With Sheets(1)
        For x = 2 To .Cells(Rows.Count, 1).End(xlUp).Row Step 1
            If .Cells(x, 1) <> "" Then
                stateCheck = .Cells(x, 1)
                .Cells(x, 1) = ""
                Sheets.Add After:=Sheets(Sheets.Count)
                ActiveSheet.Name = stateCheck
                Sheets(stateCheck).Cells(1, 1).EntireRow.Value = .Cells(1, 1).EntireRow.Value
                
                For y = x + 1 To .Cells(Rows.Count, 1).End(xlUp).Row Step 1
                    If .Cells(y, 1) = stateCheck Then
                        Sheets(stateCheck).Cells(nextRow, 1).EntireRow.Value = .Cells(y, 1).EntireRow.Value
                        .Cells(y, 1) = ""
                        nextRow = nextRow + 1
                    End If
                Next y
            End If
            nextRow = 2
        Next x
    End With


    Application.ScreenUpdating = True
    Application.EnableEvents = True


End Sub

This assumes your data is in the first AND ONLY sheet of the workbook. It won't completely delete the first sheet, but that's an easy fix. SAVE FIRST AND THEN TEST THIS MACRO AS IT WILL DELETE DATA.
Click to expand...
 
Upvote 0
Thank you so much for assisting me...please see my response to NeonRedSharpie as the same thing occurred when I ran the code you provided.

mumps said:
My apologies. I had to make a minor change. Please try this code:
Code: 
Sub CopyRows()
    Application.ScreenUpdating = False
    Dim LastRow As Long
    LastRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    Dim ws As Worksheet
    Dim state As Range
    Dim rngUniques As Range
    Sheets("Sheet1").Range("A1:A" & LastRow).AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:=Range _
        ("A1:A" & LastRow), Unique:=True
    Set rngUniques = Sheets("Sheet1").Range("A2:A" & LastRow).SpecialCells(xlCellTypeVisible)
    If Sheets("Sheet1").FilterMode Then Sheets("Sheet1").ShowAllData
    For Each state In rngUniques
        Sheets("Sheet1").Range("$A$1:$A$" & LastRow).AutoFilter Field:=1, Criteria1:=state
        Set ws = Nothing
        On Error Resume Next
        Set ws = Worksheets(state.Value)
        On Error GoTo 0
        If ws Is Nothing Then
                Worksheets.Add(After:=Sheets(Sheets.Count)).Name = state.Value
                Sheets("Sheet1").Range("A2:A" & LastRow).SpecialCells(xlCellTypeVisible).EntireRow.Copy ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
                If Sheets("Sheet1").FilterMode Then Sheets("Sheet1").ShowAllData
        End If
    Next state
    Sheets("Sheet1").UsedRange.Offset(1, 0).ClearContents
    Application.ScreenUpdating = True
End Sub
Click to expand...
 
Upvote 0
shizalot said:
Thank you for your response, but this did not work completely...

For example...I began with this...

State Column1 Column2
VA 21 Dog
VA 31 Cat
VA 41 Dog
VA 51 Cat
VA 61 Dog
VA 71 Cat
VA 81 Dog
NC 91 Cat

I ran the code and it created the two state worksheets and labeled them correctly...one for VA and one for NC, but it did not copy the NC row to the NC tab and it only copied some of the rows for VA. Also it did not delete all rows that it moved here are the results of what I ran below:

Sheet 1 - It only deleted the state cell values instead of all rows that it moved
State Column1 Column2
21 Dog
31 Cat
41 Dog
51 Cat
61 Dog
71 Cat
81 Dog
91 Cat

VA Tab - Its missing the first and last VA rows...see the starting table for comparison
[TABLE="width: 144"]
<tbody>[TR]
[TD="width: 64, bgcolor: transparent"]State[/TD]
[TD="width: 64, bgcolor: transparent"]Column1[/TD]
[TD="width: 64, bgcolor: transparent"]Column2[/TD]
[/TR]
[TR]
[TD="bgcolor: transparent"]VA[/TD]
[TD="bgcolor: transparent, align: right"]31[/TD]
[TD="bgcolor: transparent"]Cat[/TD]
[/TR]
[TR]
[TD="bgcolor: transparent"]VA[/TD]
[TD="bgcolor: transparent, align: right"]41[/TD]
[TD="bgcolor: transparent"]Dog[/TD]
[/TR]
[TR]
[TD="bgcolor: transparent"]VA[/TD]
[TD="bgcolor: transparent, align: right"]51[/TD]
[TD="bgcolor: transparent"]Cat[/TD]
[/TR]
[TR]
[TD="bgcolor: transparent"]VA[/TD]
[TD="bgcolor: transparent, align: right"]61[/TD]
[TD="bgcolor: transparent"]Dog[/TD]
[/TR]
[TR]
[TD="bgcolor: transparent"]VA[/TD]
[TD="bgcolor: transparent, align: right"]71[/TD]
[TD="bgcolor: transparent"]Cat[/TD]
[/TR]
[TR]
[TD="bgcolor: transparent"]VA[/TD]
[TD="bgcolor: transparent, align: right"]81[/TD]
[TD="bgcolor: transparent"]Dog[/TD]
[/TR]
</tbody>[/TABLE]

NC Tab - It didnt copy the NC row at all as the table was blank
[TABLE="width: 144"]
<tbody>[TR]
[TD="width: 64, bgcolor: transparent"]State[/TD]
[TD="width: 64, bgcolor: transparent"]Column1[/TD]
[TD="width: 64, bgcolor: transparent"]Column2[/TD]
[/TR]
</tbody>[/TABLE]


Please help.
Click to expand...


Code: 
Sub stateTabs()    
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    
    nextRow = 2


    With Sheets(1)
        For x = 2 To .Cells(Rows.Count, 1).End(xlUp).Row Step 1
            If .Cells(x, 1) <> "" Then
                stateCheck = .Cells(x, 1)
                Sheets.Add After:=Sheets(Sheets.Count)
                ActiveSheet.Name = stateCheck
                Sheets(stateCheck).Cells(1, 1).EntireRow.Value = .Cells(1, 1).EntireRow.Value
                
                For y = x To .Cells(Rows.Count, 1).End(xlUp).Row Step 1
                    If .Cells(y, 1) = stateCheck Then
                        Sheets(stateCheck).Cells(nextRow, 1).EntireRow.Value = .Cells(y, 1).EntireRow.Value
                        .Cells(y, 1) = ""
                        .Cells(y, 1).EntireRow.Clear
                        nextRow = nextRow + 1
                    End If
                Next y
            End If
            nextRow = 2
        Next x
    End With


    Application.ScreenUpdating = True
    Application.EnableEvents = True


End Sub

I mentioned it wouldn't delete the items from the first sheet. Try the modified code. And your sample results shows it copied VA-81 over.
 
Upvote 0
It worked when I ran it on the smaller data set, but when I expanded it to ensure that it would pick up all rows it did not. See below...

Here is what I started with:
[TABLE="width: 540"]
<tbody>[TR]
[TD]State
[/TD]
[TD]Column1
[/TD]
[TD]Column2
[/TD]
[TD]Column3
[/TD]
[TD]Column4
[/TD]
[/TR]
[TR]
[TD]VA
[/TD]
[TD="align: right"]1
[/TD]
[TD]Dog
[/TD]
[TD="align: right"]1
[/TD]
[TD]VA
[/TD]
[/TR]
[TR]
[TD]VA
[/TD]
[TD="align: right"]2
[/TD]
[TD]Cat
[/TD]
[TD="align: right"]2
[/TD]
[TD]VA
[/TD]
[/TR]
[TR]
[TD]VA
[/TD]
[TD="align: right"]3
[/TD]
[TD]Dog
[/TD]
[TD="align: right"]3
[/TD]
[TD]VA
[/TD]
[/TR]
[TR]
[TD]VA
[/TD]
[TD="align: right"]4
[/TD]
[TD]Cat
[/TD]
[TD="align: right"]4
[/TD]
[TD]VA
[/TD]
[/TR]
[TR]
[TD]VA
[/TD]
[TD="align: right"]5
[/TD]
[TD]Dog
[/TD]
[TD="align: right"]5
[/TD]
[TD]VA
[/TD]
[/TR]
[TR]
[TD]VA
[/TD]
[TD="align: right"]6
[/TD]
[TD]Cat
[/TD]
[TD="align: right"]6
[/TD]
[TD]VA
[/TD]
[/TR]
[TR]
[TD]VA
[/TD]
[TD="align: right"]7
[/TD]
[TD]Dog
[/TD]
[TD="align: right"]7
[/TD]
[TD]VA
[/TD]
[/TR]
[TR]
[TD]NC
[/TD]
[TD="align: right"]8
[/TD]
[TD]Cat
[/TD]
[TD="align: right"]8
[/TD]
[TD]NC
[/TD]
[/TR]
[TR]
[TD]VA
[/TD]
[TD="align: right"]9
[/TD]
[TD]Dog
[/TD]
[TD="align: right"]9
[/TD]
[TD]VA
[/TD]
[/TR]
[TR]
[TD]VA
[/TD]
[TD="align: right"]10
[/TD]
[TD]Cat
[/TD]
[TD="align: right"]10
[/TD]
[TD]VA
[/TD]
[/TR]
[TR]
[TD]VA
[/TD]
[TD="align: right"]11
[/TD]
[TD]Dog
[/TD]
[TD="align: right"]11
[/TD]
[TD]VA
[/TD]
[/TR]
[TR]
[TD]VA
[/TD]
[TD="align: right"]12
[/TD]
[TD]Cat
[/TD]
[TD="align: right"]12
[/TD]
[TD]VA
[/TD]
[/TR]
[TR]
[TD]VA
[/TD]
[TD="align: right"]13
[/TD]
[TD]Dog
[/TD]
[TD="align: right"]13
[/TD]
[TD]VA
[/TD]
[/TR]
[TR]
[TD]NC
[/TD]
[TD="align: right"]14
[/TD]
[TD]Cat
[/TD]
[TD="align: right"]14
[/TD]
[TD]NC
[/TD]
[/TR]
[TR]
[TD]NC
[/TD]
[TD="align: right"]15
[/TD]
[TD]Cat
[/TD]
[TD="align: right"]15
[/TD]
[TD]NC
[/TD]
[/TR]
[TR]
[TD]NC
[/TD]
[TD="align: right"]16
[/TD]
[TD]Cat
[/TD]
[TD="align: right"]16
[/TD]
[TD]NC
[/TD]
[/TR]
[TR]
[TD]NC
[/TD]
[TD="align: right"]17
[/TD]
[TD]Cat
[/TD]
[TD="align: right"]17
[/TD]
[TD]NC
[/TD]
[/TR]
[TR]
[TD]NC
[/TD]
[TD="align: right"]18
[/TD]
[TD]Cat
[/TD]
[TD="align: right"]18
[/TD]
[TD]NC
[/TD]
[/TR]
[TR]
[TD]NC
[/TD]
[TD="align: right"]19
[/TD]
[TD]Cat
[/TD]
[TD="align: right"]19
[/TD]
[TD]NC
[/TD]
[/TR]
[TR]
[TD]NC
[/TD]
[TD="align: right"]20
[/TD]
[TD]Cat
[/TD]
[TD="align: right"]20
[/TD]
[TD]NC
[/TD]
[/TR]
[TR]
[TD]NC
[/TD]
[TD="align: right"]21
[/TD]
[TD]Cat
[/TD]
[TD="align: right"]21
[/TD]
[TD]NC
[/TD]
[/TR]
[TR]
[TD]NC
[/TD]
[TD="align: right"]22
[/TD]
[TD]Cat
[/TD]
[TD="align: right"]22
[/TD]
[TD]NC
[/TD]
[/TR]
[TR]
[TD]NC
[/TD]
[TD="align: right"]23
[/TD]
[TD]Cat
[/TD]
[TD="align: right"]23
[/TD]
[TD]NC
[/TD]
[/TR]
[TR]
[TD]NC
[/TD]
[TD="align: right"]24
[/TD]
[TD]Cat
[/TD]
[TD="align: right"]24
[/TD]
[TD]NC
[/TD]
[/TR]
[TR]
[TD]NC
[/TD]
[TD="align: right"]25
[/TD]
[TD]Cat
[/TD]
[TD="align: right"]25
[/TD]
[TD]NC
[/TD]
[/TR]
[TR]
[TD]NC
[/TD]
[TD="align: right"]26
[/TD]
[TD]Cat
[/TD]
[TD="align: right"]26
[/TD]
[TD]NC
[/TD]
[/TR]
[TR]
[TD]NC
[/TD]
[TD="align: right"]27
[/TD]
[TD]Cat
[/TD]
[TD="align: right"]27
[/TD]
[TD]NC
[/TD]
[/TR]
[TR]
[TD]NC
[/TD]
[TD="align: right"]28
[/TD]
[TD]Cat
[/TD]
[TD="align: right"]28
[/TD]
[TD]NC
[/TD]
[/TR]
[TR]
[TD]KY
[/TD]
[TD="align: right"]29
[/TD]
[TD]Cat
[/TD]
[TD="align: right"]29
[/TD]
[TD]KY
[/TD]
[/TR]
[TR]
[TD]KY
[/TD]
[TD="align: right"]30
[/TD]
[TD]Cat
[/TD]
[TD="align: right"]30
[/TD]
[TD]KY
[/TD]
[/TR]
[TR]
[TD]KY
[/TD]
[TD="align: right"]31
[/TD]
[TD]Cat
[/TD]
[TD="align: right"]31
[/TD]
[TD]KY
[/TD]
[/TR]
</tbody>[/TABLE]


When it moves I should have 12 rows of VA and 3 rows of KY and 16 rows of NC, it only moved 11 for VA, 15 NC and 2 KY

VA tab
[TABLE="width: 240"]


<colgroup><col style="width: 48pt;" span="5" width="64">
<tbody>[TR]

[TD="width: 64, bgcolor: transparent"]State[/TD]

[TD="width: 64, bgcolor: transparent"]Column1[/TD]

[TD="width: 64, bgcolor: transparent"]Column2[/TD]

[TD="width: 64, bgcolor: transparent"]Column3[/TD]

[TD="width: 64, bgcolor: transparent"]Column4[/TD]

[/TR]

[TR]

[TD="bgcolor: transparent"]VA[/TD]

[TD="bgcolor: transparent, align: right"]2[/TD]

[TD="bgcolor: transparent"]Cat[/TD]

[TD="bgcolor: transparent, align: right"]2[/TD]

[TD="bgcolor: transparent"]VA[/TD]

[/TR]

[TR]

[TD="bgcolor: transparent"]VA[/TD]

[TD="bgcolor: transparent, align: right"]3[/TD]

[TD="bgcolor: transparent"]Dog[/TD]

[TD="bgcolor: transparent, align: right"]3[/TD]

[TD="bgcolor: transparent"]VA[/TD]

[/TR]

[TR]

[TD="bgcolor: transparent"]VA[/TD]

[TD="bgcolor: transparent, align: right"]4[/TD]

[TD="bgcolor: transparent"]Cat[/TD]

[TD="bgcolor: transparent, align: right"]4[/TD]

[TD="bgcolor: transparent"]VA[/TD]

[/TR]

[TR]

[TD="bgcolor: transparent"]VA[/TD]

[TD="bgcolor: transparent, align: right"]5[/TD]

[TD="bgcolor: transparent"]Dog[/TD]

[TD="bgcolor: transparent, align: right"]5[/TD]

[TD="bgcolor: transparent"]VA[/TD]

[/TR]

[TR]

[TD="bgcolor: transparent"]VA[/TD]

[TD="bgcolor: transparent, align: right"]6[/TD]

[TD="bgcolor: transparent"]Cat[/TD]

[TD="bgcolor: transparent, align: right"]6[/TD]

[TD="bgcolor: transparent"]VA[/TD]

[/TR]

[TR]

[TD="bgcolor: transparent"]VA[/TD]

[TD="bgcolor: transparent, align: right"]7[/TD]

[TD="bgcolor: transparent"]Dog[/TD]

[TD="bgcolor: transparent, align: right"]7[/TD]

[TD="bgcolor: transparent"]VA[/TD]

[/TR]

[TR]

[TD="bgcolor: transparent"]VA[/TD]

[TD="bgcolor: transparent, align: right"]9[/TD]

[TD="bgcolor: transparent"]Dog[/TD]

[TD="bgcolor: transparent, align: right"]9[/TD]

[TD="bgcolor: transparent"]VA[/TD]

[/TR]

[TR]

[TD="bgcolor: transparent"]VA[/TD]

[TD="bgcolor: transparent, align: right"]10[/TD]

[TD="bgcolor: transparent"]Cat[/TD]

[TD="bgcolor: transparent, align: right"]10[/TD]

[TD="bgcolor: transparent"]VA[/TD]

[/TR]

[TR]

[TD="bgcolor: transparent"]VA[/TD]

[TD="bgcolor: transparent, align: right"]11[/TD]

[TD="bgcolor: transparent"]Dog[/TD]

[TD="bgcolor: transparent, align: right"]11[/TD]

[TD="bgcolor: transparent"]VA[/TD]

[/TR]

[TR]

[TD="bgcolor: transparent"]VA[/TD]

[TD="bgcolor: transparent, align: right"]12[/TD]

[TD="bgcolor: transparent"]Cat[/TD]

[TD="bgcolor: transparent, align: right"]12[/TD]

[TD="bgcolor: transparent"]VA[/TD]

[/TR]

[TR]

[TD="bgcolor: transparent"][/TD]

[TD="bgcolor: transparent, align: right"]13[/TD]

[TD="bgcolor: transparent"]Dog[/TD]

[TD="bgcolor: transparent, align: right"]13[/TD]

[TD="bgcolor: transparent"]VA[/TD]

[/TR]


</tbody>[/TABLE]
NC tab
[TABLE="width: 240"]


<colgroup><col style="width: 48pt;" span="5" width="64">
<tbody>[TR]

[TD="width: 64, bgcolor: transparent"]State[/TD]

[TD="width: 64, bgcolor: transparent"]Column1[/TD]

[TD="width: 64, bgcolor: transparent"]Column2[/TD]

[TD="width: 64, bgcolor: transparent"]Column3[/TD]

[TD="width: 64, bgcolor: transparent"]Column4[/TD]

[/TR]

[TR]

[TD="bgcolor: transparent"]NC[/TD]

[TD="bgcolor: transparent, align: right"]14[/TD]

[TD="bgcolor: transparent"]Cat[/TD]

[TD="bgcolor: transparent, align: right"]14[/TD]

[TD="bgcolor: transparent"]NC[/TD]

[/TR]

[TR]

[TD="bgcolor: transparent"]NC[/TD]

[TD="bgcolor: transparent, align: right"]15[/TD]

[TD="bgcolor: transparent"]Cat[/TD]

[TD="bgcolor: transparent, align: right"]15[/TD]

[TD="bgcolor: transparent"]NC[/TD]

[/TR]

[TR]

[TD="bgcolor: transparent"]NC[/TD]

[TD="bgcolor: transparent, align: right"]16[/TD]

[TD="bgcolor: transparent"]Cat[/TD]

[TD="bgcolor: transparent, align: right"]16[/TD]

[TD="bgcolor: transparent"]NC[/TD]

[/TR]

[TR]

[TD="bgcolor: transparent"]NC[/TD]

[TD="bgcolor: transparent, align: right"]17[/TD]

[TD="bgcolor: transparent"]Cat[/TD]

[TD="bgcolor: transparent, align: right"]17[/TD]

[TD="bgcolor: transparent"]NC[/TD]

[/TR]

[TR]

[TD="bgcolor: transparent"]NC[/TD]

[TD="bgcolor: transparent, align: right"]18[/TD]

[TD="bgcolor: transparent"]Cat[/TD]

[TD="bgcolor: transparent, align: right"]18[/TD]

[TD="bgcolor: transparent"]NC[/TD]

[/TR]

[TR]

[TD="bgcolor: transparent"]NC[/TD]

[TD="bgcolor: transparent, align: right"]19[/TD]

[TD="bgcolor: transparent"]Cat[/TD]

[TD="bgcolor: transparent, align: right"]19[/TD]

[TD="bgcolor: transparent"]NC[/TD]

[/TR]

[TR]

[TD="bgcolor: transparent"]NC[/TD]

[TD="bgcolor: transparent, align: right"]20[/TD]

[TD="bgcolor: transparent"]Cat[/TD]

[TD="bgcolor: transparent, align: right"]20[/TD]

[TD="bgcolor: transparent"]NC[/TD]

[/TR]

[TR]

[TD="bgcolor: transparent"]NC[/TD]

[TD="bgcolor: transparent, align: right"]21[/TD]

[TD="bgcolor: transparent"]Cat[/TD]

[TD="bgcolor: transparent, align: right"]21[/TD]

[TD="bgcolor: transparent"]NC[/TD]

[/TR]

[TR]

[TD="bgcolor: transparent"]NC[/TD]

[TD="bgcolor: transparent, align: right"]22[/TD]

[TD="bgcolor: transparent"]Cat[/TD]

[TD="bgcolor: transparent, align: right"]22[/TD]

[TD="bgcolor: transparent"]NC[/TD]

[/TR]

[TR]

[TD="bgcolor: transparent"]NC[/TD]

[TD="bgcolor: transparent, align: right"]23[/TD]

[TD="bgcolor: transparent"]Cat[/TD]

[TD="bgcolor: transparent, align: right"]23[/TD]

[TD="bgcolor: transparent"]NC[/TD]

[/TR]

[TR]

[TD="bgcolor: transparent"]NC[/TD]

[TD="bgcolor: transparent, align: right"]24[/TD]

[TD="bgcolor: transparent"]Cat[/TD]

[TD="bgcolor: transparent, align: right"]24[/TD]

[TD="bgcolor: transparent"]NC[/TD]

[/TR]

[TR]

[TD="bgcolor: transparent"]NC[/TD]

[TD="bgcolor: transparent, align: right"]25[/TD]

[TD="bgcolor: transparent"]Cat[/TD]

[TD="bgcolor: transparent, align: right"]25[/TD]

[TD="bgcolor: transparent"]NC[/TD]

[/TR]

[TR]

[TD="bgcolor: transparent"]NC[/TD]

[TD="bgcolor: transparent, align: right"]26[/TD]

[TD="bgcolor: transparent"]Cat[/TD]

[TD="bgcolor: transparent, align: right"]26[/TD]

[TD="bgcolor: transparent"]NC[/TD]

[/TR]

[TR]

[TD="bgcolor: transparent"]NC[/TD]

[TD="bgcolor: transparent, align: right"]27[/TD]

[TD="bgcolor: transparent"]Cat[/TD]

[TD="bgcolor: transparent, align: right"]27[/TD]

[TD="bgcolor: transparent"]NC[/TD]

[/TR]

[TR]

[TD="bgcolor: transparent"]NC[/TD]

[TD="bgcolor: transparent, align: right"]28[/TD]

[TD="bgcolor: transparent"]Cat[/TD]

[TD="bgcolor: transparent, align: right"]28[/TD]

[TD="bgcolor: transparent"]NC
[/TD]

[/TR]


</tbody>[/TABLE]

KY tab
[TABLE="width: 240"]


<colgroup><col style="width: 48pt;" span="5" width="64">
<tbody>[TR]

[TD="width: 64, bgcolor: transparent"]State[/TD]

[TD="width: 64, bgcolor: transparent"]Column1[/TD]

[TD="width: 64, bgcolor: transparent"]Column2[/TD]

[TD="width: 64, bgcolor: transparent"]Column3[/TD]

[TD="width: 64, bgcolor: transparent"]Column4[/TD]

[/TR]

[TR]

[TD="bgcolor: transparent"]KY[/TD]

[TD="bgcolor: transparent, align: right"]30[/TD]

[TD="bgcolor: transparent"]Cat[/TD]

[TD="bgcolor: transparent, align: right"]30[/TD]

[TD="bgcolor: transparent"]KY[/TD]

[/TR]

[TR]

[TD="bgcolor: transparent"]KY[/TD]

[TD="bgcolor: transparent, align: right"]31[/TD]

[TD="bgcolor: transparent"]Cat[/TD]

[TD="bgcolor: transparent, align: right"]31[/TD]

[TD="bgcolor: transparent"]KY[/TD]

[/TR]


</tbody>[/TABLE]



NeonRedSharpie said:
Code: 
Sub stateTabs()    
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    
    nextRow = 2


    With Sheets(1)
        For x = 2 To .Cells(Rows.Count, 1).End(xlUp).Row Step 1
            If .Cells(x, 1) <> "" Then
                stateCheck = .Cells(x, 1)
                Sheets.Add After:=Sheets(Sheets.Count)
                ActiveSheet.Name = stateCheck
                Sheets(stateCheck).Cells(1, 1).EntireRow.Value = .Cells(1, 1).EntireRow.Value
                
                For y = x To .Cells(Rows.Count, 1).End(xlUp).Row Step 1
                    If .Cells(y, 1) = stateCheck Then
                        Sheets(stateCheck).Cells(nextRow, 1).EntireRow.Value = .Cells(y, 1).EntireRow.Value
                        .Cells(y, 1) = ""
                        .Cells(y, 1).EntireRow.Clear
                        nextRow = nextRow + 1
                    End If
                Next y
            End If
            nextRow = 2
        Next x
    End With


    Application.ScreenUpdating = True
    Application.EnableEvents = True


End Sub

I mentioned it wouldn't delete the items from the first sheet. Try the modified code. And your sample results shows it copied VA-81 over.
Click to expand...
 
Upvote 0
Using your latest sample data (large) and my latest code (once more repeated in this post), I receive complete results. Are you sure you copied the new code in? What OS/Version are you using?

Code: 
Sub stateTabs()    
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    
    nextRow = 2


    With Sheets(1)
        For x = 2 To .Cells(Rows.Count, 1).End(xlUp).Row Step 1
            If .Cells(x, 1) <> "" Then
                stateCheck = .Cells(x, 1)
                Sheets.Add After:=Sheets(Sheets.Count)
                ActiveSheet.Name = stateCheck
                Sheets(stateCheck).Cells(1, 1).EntireRow.Value = .Cells(1, 1).EntireRow.Value
                
                For y = x To .Cells(Rows.Count, 1).End(xlUp).Row Step 1
                    If .Cells(y, 1) = stateCheck Then
                        Sheets(stateCheck).Cells(nextRow, 1).EntireRow.Value = .Cells(y, 1).EntireRow.Value
                        .Cells(y, 1) = ""
                        .Cells(y, 1).EntireRow.Clear
                        nextRow = nextRow + 1
                    End If
                Next y
            End If
            nextRow = 2
        Next x
    End With


    Application.ScreenUpdating = True
    Application.EnableEvents = True


End Sub
 
Upvote 0
You are right...my mistake, I think I must have closed out and didnt save the new code when I expanded the dataset!!!! Awesome!!! Thanks so much for your help!
 
Upvote 0
You must log in or register to reply here.

Similar threads

L
  • Solved
Copying user selected rows to different workbook and under matching columns
Replies
5
Views
210
LaTwiglet85
L
U
  • Question Question
Excel Activate workbook1/sheet, Copy/paste row in workbook2/sheet, activate autofilter, return value and loop
Replies
0
Views
212
user29383902
U
H
  • Question Question
VBA Loop to Copy Cell Value from worksheets to new worksheet with Worksheet Name
Replies
4
Views
170
saboh12617
S
C
  • Question Question
Create a new row for every date in row and create multiple copies of data to new worksheet based on cell number value for each date in the row VBA
Replies
0
Views
195
Chris258
C
U
  • Question Question
Excel VBA, Loop, Copy, Loop, Paste, Autofilter, return value, Loop.
Replies
0
Views
394
user29383902
U

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