andreyman3d2k
asked on
Excel Macro pt. 2
Hi,
This question is really for matthewspatrick, as he wrote the original code to which it pertains. If anyone want's to pitch in check out the question this was related to.
I just realized that I need to add a 3rd column into the mix -- The State(s) column, column B. So there will need to be a sheet for every 3-combination. Full Name, State, Plan Type.
Also, it does kick up dupes, like you said it would. Even in this case though, I cannot name them right. Could we truncate the name down to make sure that the -[state]-[Plan Type] fits? The word "commercial" is the longest plan type, and state is 2 letters, so we need to make sure that -NJ-Commercial will fit at the end, which is 14 chars)
So can it be named something equivalent to=Concatenate(left([Full Name],16),"-",[state],"-", [Plan Type])
Thanks a ton!
Andrey
This question is really for matthewspatrick, as he wrote the original code to which it pertains. If anyone want's to pitch in check out the question this was related to.
I just realized that I need to add a 3rd column into the mix -- The State(s) column, column B. So there will need to be a sheet for every 3-combination. Full Name, State, Plan Type.
Also, it does kick up dupes, like you said it would. Even in this case though, I cannot name them right. Could we truncate the name down to make sure that the -[state]-[Plan Type] fits? The word "commercial" is the longest plan type, and state is 2 letters, so we need to make sure that -NJ-Commercial will fit at the end, which is 14 chars)
So can it be named something equivalent to=Concatenate(left([Full Name],16),"-",[state],"-",
Thanks a ton!
Andrey
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
ASKER
Hi matthewspatrick,
I just noticed and issue with the code -- for some reason it is only generating one sheet per full name, but not the rest! So for example, if there is a 'Angela Smith-AR-Commercial' sheet generated, it will not make a 'Angela Smith-MO-Commercial'. That data just vanishes...
It is super-urgent! could you help?
Thanks a ton,
Andrey
I just noticed and issue with the code -- for some reason it is only generating one sheet per full name, but not the rest! So for example, if there is a 'Angela Smith-AR-Commercial' sheet generated, it will not make a 'Angela Smith-MO-Commercial'. That data just vanishes...
It is super-urgent! could you help?
Thanks a ton,
Andrey
Please post a sample file, and I will have a look.
ASKER
Thanks. Attached is a workbook, which contains sample data layed out the way I have it, your macro, and the sheets that result when I run you macro. As you can see there are many other name-state-plan type combinations that do not get a sheet.
Thanks again,
Andrey
EE-Example.xlsm
Thanks again,
Andrey
EE-Example.xlsm
I was missing one puny line :)
The code below appears to be working now.
The code below appears to be working now.
Sub BreakItUp()
Dim dic1 As Object, dic2 As Object, dic3 As Object
Dim LastR As Long, LastC As Long
Dim arr As Variant
Dim Source As Worksheet
Dim Dest As Worksheet
Dim Counter As Long
Dim FullName As String
Dim PlanType As String
Dim State As String
Dim arr2 As Variant, arr3 As Variant
Dim Counter2 As Long, Counter3 As Long
Dim rng As Range
Dim WsName As String
Set Source = ThisWorkbook.Worksheets("Soucre")
With Source
.[a1].AutoFilter
LastR = .Cells(.Rows.Count, "a").End(xlUp).Row
LastC = .Cells(1, .Columns.Count).End(xlToLeft).Column
Set rng = .Range("a1", .Cells(LastR, LastC))
arr = rng.Value
Set dic1 = CreateObject("Scripting.Dictionary")
dic1.CompareMode = vbTextCompare
For Counter = 2 To LastR
FullName = arr(Counter, 1)
State = arr(Counter, 2)
PlanType = arr(Counter, 3)
If dic1.Exists(FullName) Then
Set dic2 = dic1.Item(FullName)
If dic2.Exists(State) Then
Set dic3 = dic2.Item(State)
dic3.Item(PlanType) = PlanType
Else
Set dic3 = CreateObject("Scripting.Dictionary")
dic3.CompareMode = vbTextCompare
dic3.Add PlanType, PlanType
dic2.Add State, dic3 'this is the line that was missing!
End If
Else
Set dic2 = CreateObject("Scripting.Dictionary")
dic2.CompareMode = vbTextCompare
Set dic3 = CreateObject("Scripting.Dictionary")
dic3.CompareMode = vbTextCompare
dic3.Add PlanType, PlanType
dic2.Add State, dic3
dic1.Add FullName, dic2
End If
Next
arr = dic1.Keys
For Counter = 0 To UBound(arr)
FullName = arr(Counter)
Set dic2 = dic1.Item(FullName)
arr2 = dic2.Keys
For Counter2 = 0 To UBound(arr2)
State = arr2(Counter2)
Set dic3 = dic2.Item(State)
arr3 = dic3.Keys
For Counter3 = 0 To UBound(arr3)
PlanType = arr3(Counter3)
.[a1].AutoFilter 1, FullName
.[a1].AutoFilter 2, State
.[a1].AutoFilter 3, PlanType
With ThisWorkbook
Set Dest = .Worksheets.Add(After:=.Worksheets(.Worksheets.Count))
End With
On Error Resume Next
WsName = "-" & State & "-" & PlanType
WsName = Left(FullName, 31 - Len(WsName)) & WsName
Do
Dest.Name = WsName
If Err <> 0 Then
Err.Clear
WsName = InputBox("Bad worksheet name. Please enter replacement", "Invalid Entry", WsName)
Else
Exit Do
End If
Loop
rng.SpecialCells(xlCellTypeVisible).Copy Dest.[a1]
Next
Next
Next
.[a1].AutoFilter
.Select
End With
Set dic1 = Nothing
Set dic2 = Nothing
Set dic3 = Nothing
MsgBox "Done"
End Sub
ASKER
Ah, genius! Thank you muchly.
Andrey
Andrey
ASKER