VBA: Split data into multiple worksheets based on column

W

waxsublime

New Member
Joined
Jul 13, 2013
Messages
17
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.

Code: 
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!
 
Last edited:
Sort by date Sort by votes
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
 
Upvote 0

Excel Facts

How can you turn a range sideways?
Copy the range. Select a blank cell. Right-click, Paste Special, then choose Transpose.
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.
 
Upvote 0
ArmyGuy45 said:
Is there a way to upload documents on here? Otherwise I will have to copy and paste.
Click to expand...

... 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
 
Upvote 0
ArmyGuy45 said:
Doc,


Lets hope this works.

https://app.box.com/s/n8lgkjx3w5k2rymapa85emrvotfji38e
Click to expand...



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:

Code: 
[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 />
 
Upvote 0
DocAElstein said:
....

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

...................................
Click to expand...

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

Thanks
Alan


Code: 
[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]
 
Upvote 0
ArmyGuy45 said:
When I first ran my code I got 2300 blank sheets with no information:rofl:. Still working on it.
Click to expand...

. 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.
 
Upvote 0
You must log in or register to reply here.

Similar threads

V
  • Solved
Need VBA to split data into multiple sheets paste formulas, formatting AND data validation
Replies
2
Views
127
vanessavalentino83
V
H
  • Solved
Splitting Data into Workbooks - EDIT HELP
Replies
1
Views
291
horrellbt01
H
S
  • Question Question
Parse data - Overwrite lines with updated data
Replies
0
Views
343
Scifo
S
S
  • Solved
VBA Parse Data. (do not want title to copy over Every time)
Replies
2
Views
708
Scifo
S
S
  • Question Question
VBA code_How to keep in Excel header row included when splitting worksheet to separate worksheets
Replies
1
Views
991
rlv01
R

Forum statistics

Threads
1,224,847
Messages
6,181,325
Members
453,032
Latest member
Pauh

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top