Splitting a Worksheet by Pairs of Values in another Worksheet

Mane

New Member
Joined
Jun 26, 2012
Messages
20
Hi Mr Excel folk,

I'm trying to split a worksheet up by pairs of values. I started by hardcoding the columns which held the pairs of values and looping through. I described the problem here:

http://www.mrexcel.com/forum/showthread.php?642933-Splitting-a-Workbook-by-Values-in-Two-Columns


I got no reply but I managed to solve the problem so the worksheet is copied into seperate sheets for each different pair of values in columns "J" & "K" using the following code:

Code:
'Split by two Col
Sub SplitByCol()
Dim lastrow As Long, LastCol As Integer, i As Long, iStart As Long, iEnd As Long
Dim ws As Worksheet, enteredData As Worksheet
Dim splitCol1 As String, splitCol2 As String
Application.ScreenUpdating = False
'worksheet containing data to split
Set eneteredData = Worksheets("exportedFinal")
With ActiveSheet
    splitCol1 = "K"
    splitCol2 = "J"
    lastrow = .Cells(Rows.Count, splitCol1).End(xlUp).Row
    LastCol = .Cells(1, Columns.Count).End(xlToLeft).Column
    .Range(.Cells(2, 1), Cells(lastrow, LastCol)).Sort Key1:=Range(splitCol1 & "2"), Order1:=xlAscending, _
        Header:=xlGuess, OrderCustom:=1, MatchCase:=True, Orientation:=xlTopToBottom
    iStart = 2
    'loop through data to split
    For i = 2 To lastrow
        If .Range(splitCol1 & i).Value <> .Range(splitCol1 & i + 1).Value And .Range(splitCol2 & i).Value <> .Range(splitCol2 & i + 1).Value Then
            iEnd = i
            Sheets.Add after:=Sheets(Sheets.Count)
            Set ws = ActiveSheet
            On Error Resume Next
            ws.Name = .Range(splitCol1 & iStart).Value + .Range(splitCol2 & iStart).Value
            On Error GoTo 0
            ws.Range(Cells(1, 1), Cells(1, LastCol)).Value = .Range(.Cells(1, 1), .Cells(1, LastCol)).Value
            With ws.Rows(1)
                .HorizontalAlignment = xlCenter
                With .Font
                    .ColorIndex = 5
                    .Bold = True
                End With
            End With
            .Range(.Cells(iStart, 1), .Cells(iEnd, LastCol)).Copy Destination:=ws.Range("A2")
            iStart = iEnd + 1
        End If
    Next i
End With
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub

What I'm trying to do now is use a seperate list to define what values in the split columns are extracted. So for example I have the values "A", "1", "B", "5", "C", "3" etc in two columns in one sheet and I want to find those pairs in columns "J" & "K" in the other sheet, and save those rows in one worksheet not seperate ones. I'm trying using the following code:

Code:
'Split by two Cols from seperate list
Sub SplitByCol()
Dim lastrow As Long, LastCol As Integer, lastrowRounds As Long, j As Long, i As Long, iStart As Long, iEnd As Long
Dim ws As Worksheet
Dim rounds As Worksheet, enteredData As Worksheet
Dim splitCol1 As String, splitCol2 As String
Application.ScreenUpdating = False
'worksheet containing list to split on
Set rounds = Worksheets("Zones and Rounds")
'worksheet containg data to split
Set enteredData = Worksheets("ExportedFINAL")
With enteredData
    splitCol1 = "J"
    splitCol2 = "K"
    lastrow = .Cells(Rows.Count, splitCol1).End(xlUp).Row
    lastrowRounds = rounds.Cells(rounds.Rows.Count, "A").End(x1Up).Row
    LastCol = .Cells(1, Columns.Count).End(xlToLeft).Column
    .Range(.Cells(2, 1), Cells(lastrow, LastCol)).Sort Key1:=Range(splitCol1 & "2"), Order1:=xlAscending, _
        Header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
    iStart = 2
    Sheets.Add after:=Sheets(Sheets.Count)
    Set ws = ActiveSheet
    'loop through list to split on
    For j = 2 To lastrowRounds
        'loop through data to split
        For i = 2 To lastrow
            If .Range(splitCol1 & i).Value <> rounds.Cells(j, "A").Value And .Range(splitCol2 & i).Value <> rounds.Cells(j, "B").Value Then
                iEnd = i
                On Error Resume Next
                ws.Name = ws.Name + .Range(splitCol1 & iStart).Value & .Range(splitCol2 & iStart).Value
                On Error GoTo 0
                ws.Range(Cells(1, 1), Cells(1, LastCol)).Value = .Range(.Cells(1, 1), .Cells(1, LastCol)).Value
                With ws.Rows(1)
                    .HorizontalAlignment = xlCenter
                    With .Font
                        .ColorIndex = 5
                        .Bold = True
                    End With
                End With
                .Range(.Cells(iStart, 1), .Cells(iEnd, LastCol)).Copy Destination:=ws.Range("A2")
                iStart = iEnd + 1
            End If
        Next i
    Next j
End With
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub

But I'm getting an error 1004 - application or object defined error. On the line
Code:
lastrowRounds = rounds.Cells(rounds.Rows.Count, "A").End(x1Up).Row
I can't see what's wrong with it but then I don't fully understand how to define ranges of cells, especially accross different worksheets.

Can anyone help??
Thanks.
 

Some videos you may like

Excel Facts

Can you sort left to right?
To sort left-to-right, use the Sort dialog box. Click Options. Choose "Sort left to right"

Mane

New Member
Joined
Jun 26, 2012
Messages
20
EDIT: for the line
Code:
If .Range(splitCol1 & i).Value <> .Range(splitCol1 & i + 1).Value And .Range(splitCol2 & i).Value <> .Range(splitCol2 & i + 1).Value Then

I meant
Code:
If UCase(CStr(.Range(splitCol1 & i).Value)) <> UCase(CStr(.Range(splitCol1 & i + 1).Value)) Or .Range(splitCol2 & i).Value <> .Range(splitCol2 & i + 1).Value Then

This is still not quite giving me the behaviour I want though; it doesn't work unless the data is already sorted by columns "J" then "K"
 
Last edited:

Mane

New Member
Joined
Jun 26, 2012
Messages
20
OK Got it! Ooops! x1Up should be xlUp - newby error sorry everyone! Still doesn't work but I might be able to work out why now!
 

Watch MrExcel Video

Forum statistics

Threads
1,123,259
Messages
5,600,572
Members
414,389
Latest member
MarkElla

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
Top