Splitting a Worksheet by Pairs of Values in another Worksheet

[Mane]

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:

'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:

'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

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.

 

[Mane]

EDIT: for the line

If .Range(splitCol1 & i).Value <> .Range(splitCol1 & i + 1).Value And .Range(splitCol2 & i).Value <> .Range(splitCol2 & i + 1).Value Then

I meant

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"

 

[Mane]

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!