Reputation: 93
This is my current code that i have gathered from other peoples posts and advice and modified it to fit my needs.
'What the code does
It currently reads values in a table, filters the values to make a unique list, it takes those values and creates a sheet called unique list with those values in a list. Based off of that list it creates a sheet for each unique value listed in the table.
'Problem
This code works great so far but now i need to add information based off of those unique values. Below i put a comment('> I would like to Insert new procedure here) to where i want put the new procedure (which will add data from the original data table). Below is the procedure i wanted to add. But when i run it, it creates way more tabs than it should and then shuts down my excel. The desired outcome is for this add in is to go to the original table with the unique values, filter the table based off of each unique and copy all of information in certain columns and then paste them back into the sheet related to that was just created before for that specific value.
I honestly think its the fact that i have rCell in the test procedure and it doesn't like that. I know how to get to the "Raw data" sheet and copy the information but i don't know how go back to the previous sheet. I would just call out that sheet based off of its name but i need it to be a loop and run for every unique value in that list.
Any help would be appreciated. I know its a lot to read. I just want to give you guys as much info to help you understand my project.
'this is the code i want to insert into my 'Pagesbydescription' macro
'test start
Sheets("Raw Data").Select
Selection.AutoFilter
ActiveSheet.ListObjects("Table3").Range.AutoFilter Field:=11, Criteria1:= _
rCell
Range("A3:J5000").Select
Selection.Copy
Sheets.Select
Range("A3").Select
ActiveSheet.Paste
Columns("A:K").EntireColumn.AutoFit
'test end
Sub PagesByDescription()
'
'PagesByDescription
'
Dim rRange As Range, rCell As Range
Dim wSheet As Worksheet
Dim wSheetStart As Worksheet
Dim strText As String
Set wSheetStart = ActiveSheet
wSheetStart.AutoFilterMode = False
'Set a range variable to the correct item column
Set rRange = Range("K4", Range("K5000").End(xlUp))
'Delete any sheet called "UniqueList"
'Turn off run time errors & delete alert
On Error Resume Next
Application.DisplayAlerts = False
Worksheets("UniqueList").Delete
'Add a sheet called "UniqueList"
Worksheets.Add().Name = "UniqueList"
'Filter the Set range so only a unique list is created
With Worksheets("UniqueList")
rRange.AdvancedFilter xlFilterCopy, , _
Worksheets("UniqueList").Range("A1"), True
'Set a range variable to the unique list, less the heading.
Set rRange = .Range("A1", .Range("A5000").End(xlUp))
End With
On Error Resume Next
With wSheetStart
For Each rCell In rRange
strText = rCell
.Range("k1").AutoFilter 1, strText
Worksheets(strText).Delete
'Add a sheet named as content of rCell
Worksheets.Add().Name = strText
'> I would like to Insert new procedure here
Next rCell
End With
With wSheetStart
.AutoFilterMode = False
.Activate
End With
On Error GoTo 0
Application.DisplayAlerts = True
Application.DisplayAlerts = False
Sheets("NA").Delete
Sheets("BODY").Delete
Sheets("BODY PREBUILD").Delete
Application.DisplayAlerts = True
Upvotes: 0
Views: 1254
Reputation: 8941
Some comments:
The upper half of Sub PagesByDescription() reads rather confusing, but may work ... you are very freely interpreting the use of With ... End With brackets
The 2nd With / Foreach suggests you want to work in sheet wSheetStart, but at this time rRange is already pointing to Unique list because you redefined it inside the first With block ... not sure if that's the intention.
I suggest you clean up your code a bit, which will make things much clearer to you:
Upvotes: 1