VBA: Split data into multiple worksheets based on column

[waxsublime]

I'm trying to get this code I found (from How to split data into multiple worksheets based on column in Excel?) to work, but it's giving me an error.

Sub parse_data()
    Dim lr As Long
    Dim ws As Worksheet
    Dim vcol, i As Integer
    Dim icol As Long
    Dim myarr As Variant
    Dim title As String
    Dim titlerow As Integer
    vcol = 4
    Set ws = Sheets("Sheet1")
    lr = ws.Cells(ws.Rows.Count, vcol).End(xlUp).Row
    title = "A1:I1"
    titlerow = ws.Range(title).Cells(1).Row
    icol = ws.Columns.Count
    ws.Cells(1, icol) = "Unique"
    For i = 2 To lr
    On Error Resume Next
    If ws.Cells(i, vcol) <> "" And Application.WorksheetFunction.Match(ws.Cells(i, vcol), ws.Columns(icol), 0) = 0 Then
    ws.Cells(ws.Rows.Count, icol).End(xlUp).Offset(1) = ws.Cells(i, vcol)
    End If
    Next
    myarr = Application.WorksheetFunction.Transpose(ws.Columns(icol).SpecialCells(xlCellTypeConstants))
    ws.Columns(icol).Clear
    For i = 2 To UBound(myarr)
    ws.Range(title).AutoFilter field:=vcol, Criteria1:=myarr(i) & ""
    If Not Evaluate("=ISREF('" & myarr(i) & "'!A1)") Then Sheets.Add(after:=Worksheets(Worksheets.Count)).Name = myarr(i) & ""
    Else
    Sheets(myarr(i) & "").Move after:=Worksheets(Worksheets.Count)
    End If
    ws.Range("A" & titlerow & ":A" & lr).EntireRow.Copy Sheets(myarr(i) & "").Range("A1")
    Sheets(myarr(i) & "").Columns.AutoFit
    Next
    ws.AutoFilterMode = False
    ws.Activate
End Sub

Any ideas on how to fix this?

Thanks!

 

[ArmyGuy45]

Doc,

Thank you for the quick replies. I am going to copy and paste the actual data from the excel sheet (after I clean up the client names, of course) and upload it on here to give you a better example.

Thanks. AG

 

[ArmyGuy45]

Doc,

I need to filter after the first "OU=Groups"

Example:CN=COHBE_VMware_Support_Site2,OU=Groups,OU=COHBE,OU=cloud,DC=cloud,DC=mypdc,DC=mynet;CN=COHBE_VMware_Support_Site1,OU=Groups,OU=COHBE,.............

So this sheet would be called "COHBE"

I am looking to have the new sheets to take the name of the OU= after groups. Those sheets need to be in alphabetical order and the memberOf needs to be in alphabetical order.

Is there a way to upload documents on here? Otherwise I will have to copy and paste.

 

[DocAElstein]

Is there a way to upload documents on here? Otherwise I will have to copy and paste.

... see my posts #21 and #42 ...... and for example try:

Box Net,
https://www.box.net


. It is always better to keep everything for everyone's benefit easy to see in the Thread.

. But if all else fails send me a Private Message (Click on my name above my picture in the left margin .when you are logged in - the rest should bbe obvious)

. I will reply then and give you my E-Mail adrdess
Do not post Email Addresses in the Thread .--​ it aint allowed

 

[ArmyGuy45]

Doc,


Lets hope this works.

https://app.box.com/s/n8lgkjx3w5k2rymapa85emrvotfji38e

 

[DocAElstein]

Doc,


Lets hope this works.

https://app.box.com/s/n8lgkjx3w5k2rymapa85emrvotfji38e

Hi ArmyGuy..

. Thanks for the file – it made it a lot easier to get the point. I think I understand fully now wot you wont.

. As I thought, it is a fairly straight forward adaption of the codes already in this Thread. – A Bit of work involved but nothing difficult, that is to say (almost**) nothing new.
.
. I suggest initially I give you the basic idea how to do it. You should at least give it a try yourself.
. Then if you do not manage it I will do it for you.

……………………….

. This would be one of many basic plans of action (All could be done quite easily with VBA)

.. 1) Make a temporary Column (which can be deleted at the end of the program) anywhere in the master sheet, for example alongside Column D. If you are not sure how to do that “cheat” by recording wot you do manually with a macro recording – (That would probably be my starting point anyway as I am learning still myself!)

. 2 )** The only new bit: put in the new Column the bits in those long strings in Column D that you want. That is to say pick out the small bits from those long Strings that will be used for both a) sorting the Master List and b) giving a name to the new sheets for the sorted data.
. One example of how to do this I will give you at the end of this Post.

. 3) Once you have done that you are at exactly the start point you were with your last project. (Just a bit easier as you do not need to do any final Alphabetical sorting of the new sheets). So if you can work through and understand the last Full code I gave you, then it should be no problem.

. if you have not cracked it by tomorrow night, then let me know late tomorrow, and if possible post any attempts you made. Then I will do it for you Wednesday or Thursday.


……

. **So here is just one way to do the new bit. It is specific to your example data and is also an unnecessarily long way around of doing it. It is intended to allow you to follow through it and understand.

. If anyone popping in on this thread can give other alternatives I think that would be very beneficial to us all. I personally would greatly appreciate someone giving a VBA code that would write in to the Range E3:E16 one of those CSE formulas that does the same job as my code. To assist anyone kind enough to do that I will give the Before and After Screen shots.
( But I expect as the actual data is very large it may be easier in fact to get the idea of wot is wanted from my code. – And also for that reason I only include the first couple of rows for Column D !!!)


. So my code first:

[color=lightgreen]'Break out the client name from the AD lines within the "Master List" to create other sheets that are in[/color]
[color=lightgreen]'alphabetical order.[/color]
[color=lightgreen]'   CN=CLOUD_AllUsers@CLIENT NAME,OU=Groups,OU=CLIENT-NAME,OU=CLOUD,DC=cloud,DC=mycompany,DC=mynet;CN=CLIENT-NAME[/color]
[color=lightgreen]'So in my forth column I have the "Member Of" information from the AD output.[/color]
[color=lightgreen]'The name of my client appears after the "@" symbol and runs until the first ",".[/color]
[color=lightgreen]'Is there a way to break out each of the client names into different sheets in alphabetical order and[/color]
[color=lightgreen]'keeping that Member Of column in alphabetical order in each sheet?[/color]
[color=lightgreen]'[/color]
'I need to filter after the first "OU=Groups"
[color=lightgreen]'  CN=COHBE_VMware_Support_Site2,OU=Groups,OU=COHBE,OU=cloud,DC=cloud,DC=mypdc,DC=mynet;CN=COHBE_VMware_Support_Site1,OU=Groups,OU=COHBE,.............[/color]
[color=lightgreen]'So this sheet would be called "COHBE"[/color]
[color=lightgreen]'I am looking to have the new sheets to take the name of the OU= after groups.[/color]
[color=lightgreen]'Those sheets need to be in alphabetical order and the memberOf needs to be in alphabetical order.[/color]
[color=lightgreen]'[/color]
[color=deepskyblue]Sub[/color] PickOutBit() 'Example of way of getin bit after OU=Groups,OU= until next
 
 [color=deepskyblue]Dim[/color] wksMasta [color=deepskyblue]As[/color] Worksheet: [color=deepskyblue]Set[/color] wksMasta = ThisWorkbook.Worksheets("Master Sheet")
 [color=deepskyblue]Dim[/color] NewSheetName [color=deepskyblue]As[/color] [color=deepskyblue]String[/color], LongString [color=deepskyblue]As[/color] String [color=lightgreen]'The Long string in column D, and the Final bit you wont.[/color]
 [color=deepskyblue]Dim[/color] NewSheetNamelengf [color=deepskyblue]As[/color] [color=deepskyblue]Long[/color] [color=lightgreen]'Character length of new Sheet Nmae[/color]
 [color=deepskyblue]Dim[/color] TempString [color=deepskyblue]As[/color] String [color=lightgreen]'Tempory Strings used along the way[/color]
 [color=deepskyblue]Dim[/color] pos1 [color=deepskyblue]As[/color] [color=deepskyblue]Long[/color], pos2 [color=deepskyblue]As[/color] [color=deepskyblue]Long[/color] [color=lightgreen]'Number from left of Start and Stop character position in long string of bit you want.[/color]
 
 [color=deepskyblue]Dim[/color] RowCount [color=deepskyblue]As[/color] [color=deepskyblue]Long[/color] [color=lightgreen]'Bound Loop variable Row Count[/color]
    [color=deepskyblue]For[/color] RowCount = 3 [color=deepskyblue]To[/color] 16 [color=deepskyblue]Step[/color] 1
    [color=deepskyblue]Let[/color] LongString = wksMasta.Range("D" & RowCount & "").Value [color=lightgreen]'get the long string: In this example from Cell D3[/color]
    [color=deepskyblue]Let[/color] TempString = Replace(LongString, "OU=Groups,OU=", "|") [color=lightgreen]'Replace the bit before where the bit we wont is with some arbritrarry marker, | is a good-un as it aint usually in any text. Make sure you choose something else if you think you may havve a | at any time in your long String[/color]
    [color=deepskyblue]Let[/color] pos1 = InStr(1, TempString, "|") + 1 [color=lightgreen]'look for the position of the | which we put in as a marker[/color]
    [color=deepskyblue]Let[/color] pos2 = InStr(pos1, TempString, ",") - 1 [color=lightgreen]'look fo next , starting where we put the |[/color]
    [color=deepskyblue]Let[/color] NewSheetNamelengf = pos2 - pos1 + 1
    [color=deepskyblue]Let[/color] NewSheetName = Mid(TempString, pos1, NewSheetNamelengf)
    [color=deepskyblue]Let[/color] wksMasta.Range("e" & RowCount & "").Value = NewSheetName
    [color=deepskyblue]Next[/color] RowCount
 
[color=deepskyblue]End[/color] [color=deepskyblue]Sub[/color] [color=lightgreen]'PickOutBit()[/color]

.

The code above will change this

<b></b><table width="10" cellpadding="1px" rules="all" style=";background-color: #FFFFFF;border: 1px solid;border-collapse: collapse; border-color: #A6AAB6"><colgroup><col width="25px" style="background-color: #E0E0F0" /><col /><col /></colgroup><thead><tr style=" background-color: #E0E0F0;text-align: center;color: #161120"><th></th><th>D</th><th>E</th></tr></thead><tbody><tr ><td style="color: #161120;text-align: center;">3</td><td style="background-color: #FFFF00;;">CN=TGCLOUD_AllUsersGroup,OU=Services,DC=cloud,DC=mypdc,DC=mynet;CN=Terminal_Services_Access,OU=Groups,OU=APP-GRP,DC=cloud,DC=mypdc,DC=mynet;CN=SQL_Admins_ITSM,OU=Groups,OU=ITSM,OU=MGMT,DC=cloud,DC=mypdc,DC=mynet</td><td style="text-align: right;;"></td></tr><tr ><td style="color: #161120;text-align: center;">4</td><td style="background-color: #7F7F7F;;">CN=GSA-OCSIT-WEBSITES_VMware_Support_Site1,OU=Groups,OU=GSA-OCSIT-WEBSITES,OU=cloud,DC=cloud,DC=mypdc,DC=mynet;CN=DHS-HQOPA_RTG-Prod_MSS_Users,OU=Groups,OU=DHS-HQOPA_RTG-Prod,OU=cloud,DC=cloud,DC=mypdc,DC=mynet;CN=DHS-HQOPA_RTG-NonProd_MSS_Users,OU=Groups,OU=DHS-HQOPA_RTG-NonProd,OU=cloud,DC=cloud,DC=mypdc,DC=mynet;CN=my_myF-DEMO-NGA_VMware_Support_Site1,OU=Groups,OU=myF-DEMO-NGA,OU=cloud,DC=cloud,DC=mypdc,DC=mynet;CN=my_myF-DEMO-MONT_VMware_Support_Site1,OU=Groups,OU=myF-DEMO-MONT,OU=cloud,DC=cloud,DC=mypdc,DC=mynet;CN=TGCLOUD_AllAdminsGroup,OU=Services,DC=cloud,DC=mypdc,DC=mynet;CN=Terminal_Services_Access,OU=Groups,OU=APP-GRP,DC=cloud,DC=mypdc,DC=mynet;CN=myFED_Admins_Reporting,OU=Groups,OU=Crystal_Report,OU=MGMT,DC=cloud,DC=mypdc,DC=mynet;CN=my_Srv_MGMT_Users,OU=Groups,OU=my-ADMIN-PDC-GSA,OU=cloud,DC=cloud,DC=mypdc,DC=mynet;CN=my_Info_Portal_Users,OU=Groups,OU=my-ADMIN-PDC-GSA,OU=cloud,DC=cloud,DC=mypdc,DC=mynet;CN=my_Man_Sec_Srv_Users,OU=Groups,OU=my-ADMIN-PDC-GSA,OU=cloud,DC=cloud,DC=mypdc,DC=mynet;CN=my_Org_vcd_Publish,OU=Groups,OU=my-ADMIN-PDC-GSA,OU=cloud,DC=cloud,DC=mypdc,DC=mynet;CN=my_Org_vcd_Author,OU=Groups,OU=my-ADMIN-PDC-GSA,OU=cloud,DC=cloud,DC=mypdc,DC=mynet;CN=PDC_PureShare_Admins,OU=Groups,OU=my-ADMIN-PDC-GSA,OU=cloud,DC=cloud,DC=mypdc,DC=mynet;CN=PDC_Portal_Admins,OU=Groups,OU=my-ADMIN-PDC-GSA,OU=cloud,DC=cloud,DC=mypdc,DC=mynet;CN=my_Org_vcd_Admin,OU=Groups,OU=my-ADMIN-PDC-GSA,OU=cloud,DC=cloud,DC=mypdc,DC=mynet;CN=PDC_Tapestry_Admins,OU=Groups,OU=Tapestry,OU=MGMT,DC=cloud,DC=mypdc,DC=mynet;CN=PDC_Admins,OU=Groups,OU=my-ADMIN-PDC-GSA,OU=cloud,DC=cloud,DC=mypdc,DC=mynet;CN=PDC_Admins_vCenter,OU=Groups,OU=VMware-Mgmt,OU=MGMT,DC=cloud,DC=mypdc,DC=mynet;CN=PDC_Admins_FWMgmt,OU=Groups,OU=FWMgmt,OU=MGMT,DC=cloud,DC=mypdc,DC=mynet;CN=PDC_Admins_vCloud,OU=Groups,OU=VMware-Mgmt,OU=MGMT,DC=cloud,DC=mypdc,DC=mynet;CN=PDC_Admins_BladeLogic,OU=Groups,OU=BladeLogic,OU=MGMT,DC=cloud,DC=mypdc,DC=mynet;CN=PDC_Admins_ITSM,OU=Groups,OU=ITSM,OU=MGMT,DC=cloud,DC=mypdc,DC=mynet;CN=PDC_Unix_Admins,OU=Groups,OU=UNIX-Admin,OU=US-Staff,OU=Staff,OU=MGMT,DC=cloud,DC=mypdc,DC=mynet;CN=DnsAdmins,CN=Users,DC=cloud,DC=mypdc,DC=mynet</td><td style="text-align: right;;"></td></tr></tbody></table><p style="width:3,6em;font-weight:bold;margin:0;padding:0.2em 0.6em 0.2em 0.5em;border: 1px solid #A6AAB6;border-top:none;text-align: center;background-color: #E0E0F0;color: #161120">Master Sheet</p><br /><br />

.
………. To this






<b></b><table width="10" cellpadding="1px" rules="all" style=";background-color: #FFFFFF;border: 1px solid;border-collapse: collapse; border-color: #A6AAB6"><colgroup><col width="25px" style="background-color: #E0E0F0" /><col /></colgroup><thead><tr style=" background-color: #E0E0F0;text-align: center;color: #161120"><th></th><th>E</th></tr></thead><tbody><tr ><td style="color: #161120;text-align: center;">3</td><td style=";">APP-GRP</td></tr><tr ><td style="color: #161120;text-align: center;">4</td><td style=";">GSA-OCSIT-WEBSITES</td></tr><tr ><td style="color: #161120;text-align: center;">5</td><td style=";">APP-GRP</td></tr><tr ><td style="color: #161120;text-align: center;">6</td><td style=";">APP-GRP</td></tr><tr ><td style="color: #161120;text-align: center;">7</td><td style=";">COHBE</td></tr><tr ><td style="color: #161120;text-align: center;">8</td><td style=";">DHSNG</td></tr><tr ><td style="color: #161120;text-align: center;">9</td><td style=";">APP-GRP</td></tr><tr ><td style="color: #161120;text-align: center;">10</td><td style=";">APP-GRP</td></tr><tr ><td style="color: #161120;text-align: center;">11</td><td style=";">APP-GRP</td></tr><tr ><td style="color: #161120;text-align: center;">12</td><td style=";">my-ADMIN-PDC-GSA</td></tr><tr ><td style="color: #161120;text-align: center;">13</td><td style=";">myF-DEMO-MONT</td></tr><tr ><td style="color: #161120;text-align: center;">14</td><td style=";">myF-ADIP-BIO</td></tr><tr ><td style="color: #161120;text-align: center;">15</td><td style=";">NJDCA</td></tr><tr ><td style="color: #161120;text-align: center;">16</td><td style=";">DHSHQ-ONE-NET</td></tr></tbody></table><p style="width:3,6em;font-weight:bold;margin:0;padding:0.2em 0.6em 0.2em 0.5em;border: 1px solid #A6AAB6;border-top:none;text-align: center;background-color: #E0E0F0;color: #161120">Master Sheet</p><br /><br />

 

[DocAElstein]

....

...........
. If anyone popping in on this thread can give other alternatives I think that would be very beneficial to us all. I personally would greatly appreciate someone giving a VBA code that would write in to the Range E3:E16 one of those CSE formulas that does the same job as my code. .........
......
( But I expect as the actual data is very large it may be easier in fact to get the idea of wot is wanted from my code. – And also for that reason I only include the first couple of rows for Column D !!!)


. So my code first:
......

...................................

... my code again without the comments to make it a bit clearer for anyond wanting to add an alternative...

Thanks
Alan

[color=darkblue]Sub[/color] PickOutBit()
 
 [color=darkblue]Dim[/color] wksMasta [color=darkblue]As[/color] Worksheet: [color=darkblue]Set[/color] wksMasta = ThisWorkbook.Worksheets("Master Sheet")
 [color=darkblue]Dim[/color] NewSheetName [color=darkblue]As[/color] [color=darkblue]String[/color], LongString [color=darkblue]As[/color] String
 [color=darkblue]Dim[/color] NewSheetNamelengf [color=darkblue]As[/color] [color=darkblue]Long[/color]
 [color=darkblue]Dim[/color] TempString [color=darkblue]As[/color] String
 [color=darkblue]Dim[/color] pos1 [color=darkblue]As[/color] [color=darkblue]Long[/color], pos2 [color=darkblue]As[/color] [color=darkblue]Long[/color]
 
 [color=darkblue]Dim[/color] RowCount [color=darkblue]As[/color] [color=darkblue]Long[/color]
    [color=darkblue]For[/color] RowCount = 3 [color=darkblue]To[/color] 16 [color=darkblue]Step[/color] 1
    [color=darkblue]Let[/color] LongString = wksMasta.Range("D" & RowCount & "").Value
    [color=darkblue]Let[/color] TempString = Replace(LongString, "OU=Groups,OU=", "|")
    [color=darkblue]Let[/color] pos1 = InStr(1, TempString, "|") + 1
    [color=darkblue]Let[/color] pos2 = InStr(pos1, TempString, ",") - 1
    [color=darkblue]Let[/color] NewSheetNamelengf = pos2 - pos1 + 1
    [color=darkblue]Let[/color] NewSheetName = Mid(TempString, pos1, NewSheetNamelengf)
    [color=darkblue]Let[/color] wksMasta.Range("e" & RowCount & "").Value = NewSheetName
    [color=darkblue]Next[/color] RowCount


[color=darkblue]End[/color] [color=darkblue]Sub[/color]

 

[ArmyGuy45]

Thanks for the help Doc.

Ill give the code a shot and let you know how it goes.

 

[DocAElstein]

Thanks for the help Doc.

Ill give the code a shot and let you know how it goes.

Ok.
' ave a go...

 

[ArmyGuy45]

When I first ran my code I got 2300 blank sheets with no information. Still working on it.

 

[DocAElstein]

When I first ran my code I got 2300 blank sheets with no information. Still working on it.

. Ok. keep at it.

. I'll do a code version for you in the meantime using a slightly diferent method so you have at least one code working. I find it always useful to have some differnt approaches.. some things seem to work better in different systems etc.
. I'll drop my version off tomororrow and maybe see if I can see where yours is going wrong....

. catch you tomorrow

Alan.