Hi Army man,
. ……..done a code for ya..
. ... I took the unusual (for me) starting point of actually writing a “UDF”, (User Defined Function), to do that initial bit of getting the shortened string you want to use as Filtering criteria and New Sheet Names.
.
. (
I always prefer to keep everything in one code especially when I try to give it to anyone.. But I have to confess it starts getting a bit too big and messy. …. And I woz practicing these things just now… …….)
.
.
. FYI in case you don’t know. When you make a UDF you have a new “Home Made” Function. Let’s call it “UDArmyGeezerPickOutBit”.
.
. The nice thing is if you stick it in a Normal Module as a
Public Function UDArmyGeezerPickOutBit(LongStrings As Rang____________etc.
.
….. then you have it available both as a normal Spreadsheet Function and can use it in a VBA Code. Nice ‘cos you can check it works first in the Spread sheet.
.
. So get the UDF up and running before you do anything else..
.
. Copy and paste this in a normal Module.
Code:
[COLOR=blue]Public[/COLOR] [COLOR=blue]Function[/COLOR] UDArmyGeezerPickOutBit(LongStrings [COLOR=blue]As[/COLOR] Range, StartString [COLOR=blue]As[/COLOR] String, StopString [COLOR=blue]As[/COLOR] String)
[COLOR=blue]Dim[/COLOR] vOut() [COLOR=blue]As[/COLOR] [COLOR=blue]Variant[/COLOR] [COLOR=lightgreen]' Array but individual elements Has to be variant as it sees the Functions below[/COLOR]
[COLOR=blue]Dim[/COLOR] x [COLOR=blue]As[/COLOR] [COLOR=blue]Long[/COLOR], y [COLOR=blue]As[/COLOR] Long
[COLOR=blue]Dim[/COLOR] TempString [COLOR=blue]As[/COLOR] String [COLOR=lightgreen]'Tempory Strings used along the way[/COLOR]
[COLOR=blue]ReDim[/COLOR] vOut(1 [COLOR=blue]To[/COLOR] LongStrings.Rows.Count, 1 [COLOR=blue]To[/COLOR] LongStrings.Columns.Count)
[COLOR=blue]For[/COLOR] x = 1 [COLOR=blue]To[/COLOR] LongStrings.Rows.Count
[COLOR=blue]For[/COLOR] y = 1 [COLOR=blue]To[/COLOR] LongStrings.Columns.Count
[COLOR=blue]Let[/COLOR] TempString = Replace(Replace(LongStrings(x, y).Value, StartString, "|", 1), StopString, "|", InStr(1, Replace(LongStrings(x, y).Value, StartString, "|", 1), "|") + 1)
vOut(x, y) = Mid(TempString, 1, InStr(1, TempString, "|") - 1)
Debug.Print vOut(x, y)
[COLOR=blue]Next[/COLOR] y
[COLOR=blue]Next[/COLOR] x
UDArmyGeezerPickOutBit = vOut
[COLOR=blue]End[/COLOR] [COLOR=blue]Function[/COLOR] [COLOR=lightgreen]'UDArmyGeezerPickOutBit[/COLOR]
. It is not as complicated as it looks. Just lots of simple steps with simple functions like in the example I gave in Post #55 and #56 all stuck together in long line.
. I can open it up and explain everything in it in full detail if you or anyone asks.. Also it was the first attempt I tried. If you play around with different simple function combinations you can probably come up with infinite variations some of which would be shorter… (
I’ll will probably post again anyway with another UDF and / or explanations to it for my own benefit for when the Thread gets revived again.. )
. If you have done it right then if you go back into your spreadsheet and type in any cell something like
=u
Then the usual Spreadsheet intellisense should give you an extra option
=UDArmyGeezerPickOutBit(
In the drop down suggestion list that usually pops up.
. Then you can test it easily by writing in some cell a formula which references a cell with one of those long strings , Like this for example (I shortened the long string a bit just for clarity of presentation here):
Unknown[TABLE="width: 10"]
<colgroup><col style="background-color: #E0E0F0" width="25px"><col></colgroup><thead>[TR="bgcolor: #E0E0F0"]
[TH][/TH]
[TH]D[/TH]
[/TR]
</thead><tbody>[TR]
[TD="align: center"]16[/TD]
[TD="bgcolor: #FF0000, align: center"]Site1,OU=Groups,OU=DHSHQ-ONE-NET,OU=cloud,DC=cloud,DC=mypdc,DC=mynet[/TD]
[/TR]
[TR]
[TD="align: center"]17[/TD]
[TD="align: center"][/TD]
[/TR]
[TR]
[TD="align: center"]18[/TD]
[TD="align: center"]DHSHQ-ONE-NET[/TD]
[/TR]
</tbody>[/TABLE]
Master Sheet
[TABLE="width: 85%"]
<tbody>[TR]
[TD]
Worksheet Formulas[TABLE="width: 100%"]
<thead>[TR="bgcolor: #E0E0F0"]
[TH="width: 10px"]Cell[/TH]
[TH="align: left"]Formula[/TH]
[/TR]
</thead><tbody>[TR]
[TH="width: 10px, bgcolor: #E0E0F0"]D18[/TH]
[TD="align: left"]=UDArmyGeezerPickOutBit(
D16,"OU=Groups,OU=",",")[/TD]
[/TR]
</tbody>[/TABLE]
[/TD]
[/TR]
</tbody>[/TABLE]
. At his point of course you can decide whether it is worth modifying the code to give you a column with those Picked out bits, or whether just to type that formula once in a new column alongside column D and dragged it down.
. NOTE: Once you have convinced yourself that Private Function is there and working, you may want to delete any formulas using it in t
he spreadsheet before running any codes. Otherwise the code seems to trigger the Function off erratically sometimes. (Not sure why yet. I may start a Thread asking for help on that one…)
. For now I have put the UDF in the full code, that is to say I access (Call) that function when I need it in the code.
. So here is a Code version I seem to have working now with your test data. I have not tested it thoroughly, and I think it is a bit much to take in one go. But as you surprised me that you got that last ragged code of mine working first time I thought I would post it to be going on with. But I expect we may want to discuss it further and it could be easier to swop some Workbooks / worksheet with data and / or the working macros in it.. This code uses a slightly different method along the lines of wot I did in post #23. It makes a temporary sheet rather than a temporary array for your unique Sheet name bits.
Code
Code:
[COLOR=blue]Option[/COLOR] [COLOR=blue]Explicit[/COLOR] [COLOR=lightgreen]'Not necerssary but good practice to keep computer memery usage to minimum (and helps show up errors)[/COLOR]
[COLOR=blue]Sub[/COLOR] ArmyGeezerUniqueSheet()
[COLOR=lightgreen]'Application.ScreenUpdating = False 'Not necerssary but speeds things up a bit, by turning screen updating off. Usually best to 'Comment it out initially to see a bit better wot is going on.[/COLOR]
[COLOR=blue]Dim[/COLOR] wksMasta [COLOR=blue]As[/COLOR] Worksheet: [COLOR=blue]Set[/COLOR] wksMasta = ThisWorkbook.Worksheets("Master Sheet") [COLOR=lightgreen]'Give abbreviations the Methods, properties, sub-Objects through dot of Worksheets Object[/COLOR]
[COLOR=blue]On[/COLOR] [COLOR=blue]Error[/COLOR] [COLOR=blue]GoTo[/COLOR] TheEnd [COLOR=lightgreen]'If anything goes wrong go to the End instead of crashing.[/COLOR]
[COLOR=lightgreen]'1) Start Bit option to Delete Sheets / Tabs------------[/COLOR]
[COLOR=blue]Dim[/COLOR] ws [COLOR=blue]As[/COLOR] Worksheet [COLOR=lightgreen]'ws now has Methods and Properties of Worksheets obtained with typing . dot after it![/COLOR]
Application.DisplayAlerts = [COLOR=blue]False[/COLOR] [COLOR=lightgreen]'Prevents being asked everytime if you really want to delete the Workbook[/COLOR]
[COLOR=blue]For[/COLOR] [COLOR=blue]Each[/COLOR] ws [COLOR=blue]In[/COLOR] ActiveWorkbook.Worksheets
[COLOR=blue]If[/COLOR] ws.Name <> "Master Sheet" And ws.Name <> "Masta sheet" [COLOR=blue]Then[/COLOR]
ws.Delete
[COLOR=blue]Else[/COLOR] [COLOR=lightgreen]'Presumably then the worksheet name is FullDataSheet so[/COLOR]
[COLOR=lightgreen]' do nothing (Don't delete it!)[/COLOR]
[COLOR=blue]End[/COLOR] [COLOR=blue]If[/COLOR]
[COLOR=blue]Next[/COLOR]
Application.DisplayAlerts = [COLOR=blue]True[/COLOR] [COLOR=lightgreen]'Turn it back on[/COLOR]
[COLOR=lightgreen]'End Bit to delete new Sheets / Tabs------------[/COLOR]
[COLOR=lightgreen]'2) Bit to make new (Temporary) column for Picked out bits from long string in Column D[/COLOR]
wksMasta.Columns("E:E").Insert Shift:=xlToRight [COLOR=lightgreen]'This inserts a new Column after Column D[/COLOR]
[COLOR=blue]Dim[/COLOR] lrMasta [COLOR=blue]As[/COLOR] [COLOR=blue]Long[/COLOR] [COLOR=lightgreen]'last Roww in Masta Sheet. Long is a Big whole Number limit (-2,147,483,648 to 2,147,483,647). Smaller numbers such as Byte, Integer etc. are typically converted to long in the computer so there are no Memory advantages of Dimensioning smaller.. http://www.mrexcel.com/forum/excel-questions/803662-byte-backward-loop-4.html[/COLOR]
[COLOR=blue]Let[/COLOR] lrMasta = wksMasta.Cells.Find(What:="*", after:=wksMasta.Cells(1, 1), Lookat:=xlPart, LookIn:=xlFormulas, SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row [COLOR=lightgreen]'Get last Row with entry anywhere for Sheet1. Method: You start at first cell then go backwards (which effectively starts at end of sheet), sercching for anything ( = * ) by rows, then get the row number. This allows for different excel versions with different available Row numbers) Just a different method here for fun- finds last row in sheet rather than row for last entry in particular cell[/COLOR]
[COLOR=blue]Let[/COLOR] lrMasta = wksMasta.Cells(Rows.Count, 4).End(xlUp).Row [COLOR=lightgreen]'Better alternative for single column work. - Starting at last Spreadsheet Row in column 4 (D), quasi "go back up" / return the last cell with entry in it as a Range object using .End Property and obtain rows from the .Rows Property of that returned Range Object[/COLOR]
[COLOR=blue]Dim[/COLOR] rngD [COLOR=blue]As[/COLOR] Range: [COLOR=blue]Set[/COLOR] rngD = wksMasta.Range("D3:D" & lrMasta & "") [COLOR=lightgreen]'Data Column range .. Give abbreviations >>>[/COLOR]
[COLOR=blue]Let[/COLOR] rngD.Offset(0, 1).Value = UDArmyGeezerPickOutBit(rngD, "OU=Groups,OU=", ",") [COLOR=lightgreen]'Our UDF is set to work with our Range in Column D. The Offset Property bit is just a neat - here it returns a range that is one place to the right. That saves us having to Dimension and set a rngE to use in an alternative code line RngE = UDArmyGeezerPickOutBit(rngD, "OU=Groups,OU=", ",")[/COLOR]
[COLOR=lightgreen]'3)Add new Worksheets----------------------------------[/COLOR]
[COLOR=lightgreen]'3a)First make 1 tempory sheet For Unique Sheet Names.[/COLOR]
[COLOR=blue]Let[/COLOR] Worksheets.Add(after:=Worksheets(1)).Name = "Unique1" [COLOR=lightgreen]'Add a Worksheet (after the First ever added or there), named Unique1 for now[/COLOR]
[COLOR=blue]Let[/COLOR] wksMasta.Range("E1").Value = "Temp Heading" [COLOR=lightgreen]'An annoying characteristic of advanced Filter is that it Requires a Heading (which it always copies with the other filtered cells)[/COLOR]
wksMasta.Range("E1:E" & lrMasta & "").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Worksheets("Unique1").Range("A1"), Unique:=[COLOR=blue]True[/COLOR] [COLOR=lightgreen]'Copies entire E Column to first column in sheet2 (Tempory made "Unique1" sheet), The important bit is Unique:=True - that only copies unique bits[/COLOR]
[COLOR=lightgreen]'---------------------[/COLOR]
[COLOR=blue]Dim[/COLOR] LastUnqRow [COLOR=blue]As[/COLOR] [COLOR=blue]Long[/COLOR], UqeRow [COLOR=blue]As[/COLOR] [COLOR=blue]Long[/COLOR] [COLOR=lightgreen]'Rows in Tempory Unique sheet.[/COLOR]
[COLOR=blue]Let[/COLOR] LastUnqRow = Worksheets("Unique1").Cells.Find(What:="*", after:=Worksheets("Unique1").Cells(1, 1), Lookat:=xlPart, LookIn:=xlFormulas, SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row [COLOR=lightgreen]'Get last Unique Row for use in next loop. method: You starta at first cell then go backwards (which effectively starts at end of sheet. This allows for different excel versions with different available Row numbers)[/COLOR]
[COLOR=lightgreen]'3b)go through making new sheets and copying filtered data to them[/COLOR]
[COLOR=blue]Dim[/COLOR] TempShtName [COLOR=blue]As[/COLOR] [COLOR=blue]String[/COLOR] [COLOR=lightgreen]'Temporary Sheet Name for newly made sheet, not kept constant, used / updated in looping[/COLOR]
[COLOR=blue]For[/COLOR] UqeRow = 2 [COLOR=blue]To[/COLOR] LastUnqRow [COLOR=blue]Step[/COLOR] 1 [COLOR=lightgreen]'[/COLOR]
'Make new sheets-----------------------
[COLOR=blue]If[/COLOR] Sheets("Unique1").Cells(UqeRow, 1).Text <> "" [COLOR=blue]Then[/COLOR] [COLOR=lightgreen]'Assuming a Record is there[/COLOR]
[COLOR=blue]Let[/COLOR] TempShtName = Sheets("Unique1").Cells(UqeRow, 1).Text [COLOR=lightgreen]'Put name in Record variable[/COLOR]
[COLOR=blue]Let[/COLOR] Worksheets.Add(after:=Worksheets(1)).Name = TempShtName [COLOR=lightgreen]'Add new worksheet with name TempShtName[/COLOR]
[COLOR=blue]With[/COLOR] wksMasta [COLOR=lightgreen]'Copying data to new sheet----[/COLOR]
.UsedRange.AutoFilter Field:=5, Criteria1:=TempShtName [COLOR=lightgreen]'Filter out everything except with that with the appropriate Record (makes visible based on the criteria (Column 5 (E)) only the stuff you want??)....[/COLOR]
.UsedRange.SpecialCells(xlCellTypeVisible).Copy Destination:=Sheets(TempShtName).Range("A1") [COLOR=lightgreen]', then combine it with SpecialCells to just copy that wot you see, (and then send it to the relavent new sheet , name n).. ( Idid notice that it works the same without the .SpecialCells(xlCellTypeVisible) bit, - but that mayjust be Excel “guessing wot you want” as it does, that is to say it copies by default wot is visible?- not too sure on that one yet.)[/COLOR]
[COLOR=blue]End[/COLOR] [COLOR=blue]With[/COLOR] [COLOR=lightgreen]'----------------------------------[/COLOR]
Application.DisplayAlerts = [COLOR=blue]True[/COLOR] [COLOR=lightgreen]'This is normally just done once at the end, but is useful for debugging purposes to do here. It makes all of Master sheet re visible[/COLOR]
[COLOR=blue]With[/COLOR] Sheets(TempShtName).UsedRange [COLOR=lightgreen]'Bit of simple Format Tidying up[/COLOR]
.WrapText = [COLOR=blue]False[/COLOR]
.Columns.AutoFit
[COLOR=blue]End[/COLOR] [COLOR=blue]With[/COLOR]
[COLOR=blue]Else[/COLOR]
[COLOR=lightgreen]'Do nothing if no Record given[/COLOR]
[COLOR=blue]End[/COLOR] [COLOR=blue]If[/COLOR]
[COLOR=lightgreen]'-----------------------------[/COLOR]
[COLOR=blue]Next[/COLOR] UqeRow [COLOR=lightgreen]'Go back and make another new sheet[/COLOR]
[COLOR=lightgreen]'------------------------------------------------------------[/COLOR]
wksMasta.AutoFilterMode = [COLOR=blue]False[/COLOR]
Application.DisplayAlerts = [COLOR=blue]False[/COLOR] [COLOR=lightgreen]'Prevent being asked if you really want to delete Temporary Unique sheet[/COLOR]
Worksheets("Unique1").Delete [COLOR=lightgreen]' delete the Temporary the filtered name sheet as you do not need it any more[/COLOR]
wksMasta.Columns("E:E").Delete [COLOR=lightgreen]'Delete Tempory Column E (If you wont too!! - might want to comment this out if you want to keep it?)[/COLOR]
Application.DisplayAlerts = [COLOR=blue]True[/COLOR]
Application.ScreenUpdating = [COLOR=blue]True[/COLOR] [COLOR=lightgreen]'Turn screen "back on" or screen is "dead"[/COLOR]
[COLOR=blue]Exit[/COLOR] [COLOR=blue]Sub[/COLOR] [COLOR=lightgreen]'We stop code here assuming it worked (or at least did not crash!)[/COLOR]
TheEnd:
Application.ScreenUpdating = [COLOR=blue]True[/COLOR] [COLOR=lightgreen]'Important to do this here so if anything goes wrong then the screen updating is turned back on, ohterwisee the screen is dead[/COLOR]
MsgBox (Err.Description) [COLOR=lightgreen]'Print out error message in Message Box[/COLOR]
[COLOR=blue]End[/COLOR] [COLOR=blue]Sub[/COLOR] [COLOR=lightgreen]'ArmyGeezerUniqueSheet[/COLOR]
Have Fun with it, maybe catch you later
Alan
P.s.1 I have not allowed for the possibility of the String bit you want not being in that long string in column D. There would be various ways of dealing with that, such as making the function return nothing or get the VBA code to check for that occurrence and act accordingly etc. etc. .. Just a bit more work. I noticed it was not in the D2 of your sample data, so I just start at Row 3 and miss it out
P.s. 2 Thanks RoryA. for the “RoaryLeftPubic” and other stuff from about Post #82 here..
http://www.mrexcel.com/forum/excel-...ic-applications-evaluate-range-vlookup-9.html
…
without stuff learnt from there I would not be Functioning here (Publically 
)
