Subscript out of range error.

[nikneven]

basically, I have a main data dump sheet named ContestReport. I'd like to create sheets based on Culumn B (minus the header) and then copy the row to the appropriate sheet based on the value of B. This is correctly creating the sheets, but I'm running into an error with the copying and I am not sure why. There are no blank rows or cells in B

Sub ContestReport()
Dim lstRow
Dim Topic
Dim numTopics
Dim nxtRow
Dim nxtTopic
With Sheets("ContestReport")
'Create List of Unique Topic Names in Column J
numTopics = .Range("B" & Rows.Count).End(xlUp).Row
.Range("B1:B" & numTopics).AdvancedFilter Action:=xlFilterCopy, _
CopyToRange:=.Range("U1"), Unique:=True
'Determine How Many Cities Are In The List
lstRow = .Range("U" & Rows.Count).End(xlUp).Row
'Loop through Column J Creating Sheets and Copy Header Row
For Topic = 2 To lstRow
Sheets.Add after:=Sheets(Sheets.Count)
ActiveSheet.Name = .Range("U" & Topic).Value
.Rows(1).EntireRow.Copy _
Destination:=ActiveSheet.Range("A1")
Next
'Delete List In Column J
.Range("U1").EntireColumn.ClearContents
'Loop through Column G and copy Rows to Sheet Based On Topic Name
For nxtTopic = 2 To numTopics
nxtRow = Sheets(Range("B" & nxtTopic).Value).Range("A" & Rows.Count).End(xlUp).Row + 1
.Rows(nxtTopic).EntireRow.Copy _
Destination:=Sheets(Range("B" & nxtTopic).Value).Range("A" & nxtRow)
Next
End With
End Sub




I am getting a Runtime error 9 - Subscript out of range on this line:
nxtRow = Sheets(Range("B" & nxtTopic).Value).Range("B" & Rows.Count).End(xlUp).Row + 1

and I cant figure it out.

Any help would be greatly appreciated.

 

[nikneven]

Nevermind, I am a moron. I knew as soon as I posted I would figure it out. Needed to reselect the original sheet.


For anyone interested in this, working vba:

Sub ContestReport()
Dim lstRow
Dim Topic
Dim numTopics
Dim nxtRow
Dim nxtTopic
With Sheets("ContestReport")
'Create List of Unique Topic Names in Column J
numTopics = .Range("B" & Rows.Count).End(xlUp).Row
.Range("B1:B" & numTopics).AdvancedFilter Action:=xlFilterCopy, _
CopyToRange:=.Range("U1"), Unique:=True
'Determine How Many Cities Are In The List
lstRow = .Range("U" & Rows.Count).End(xlUp).Row
'Loop through Column J Creating Sheets and Copy Header Row
For Topic = 2 To lstRow
Sheets.Add after:=Sheets(Sheets.Count)
ActiveSheet.Name = .Range("U" & Topic).Value
.Rows(1).EntireRow.Copy _
Destination:=ActiveSheet.Range("A1")
Next
'Delete List In Column J
Sheets("ContestReport").Select
.Range("U1").EntireColumn.ClearContents
'Loop through Column G and copy Rows to Sheet Based On Topic Name
For nxtTopic = 2 To numTopics
nxtRow = Sheets(Range("B" & nxtTopic).Value).Range("A" & Rows.Count).End(xlUp).Row + 1
.Rows(nxtTopic).EntireRow.Copy _
Destination:=Sheets(Range("B" & nxtTopic).Value).Range("A" & nxtRow)
Next
End With
End Sub

 

[pgc01]

Hi

You don't usually select objects in vba. I think you just have to qualify the range. Try:

        nxtRow = Sheets([SIZE=4][COLOR=red][B].[/B][/COLOR][/SIZE]Range("B" & nxtTopic).Value).Range("A" & Rows.Count).End(xlUp).Row + 1