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!

 

[DocAElstein]

.....will not quote next time. .......

... Quoting is OK.. just not necerssarily everthing, like the whole code etc.

. Reply with quote but edit bits out that are nort relevant Like wot I did above .. just makes Thread a bit easier to follow!!

 

[ArmyGuy45]

So with the error I am getting, did I miss defining UDArmyGeezerPickOutBit?

 

[DocAElstein]

So with the error I am getting, did I miss defining UDArmyGeezerPickOutBit?

Hi,
. I think working at this distance it is impossible for me to help you further with the little feedback you have given.
. Read again very carefully my post #61. Sounds like maybe you still have missed the point about the Public Function. Maybe you have got the point - but you are not telling me enough about what you have done or tried for me to know! So I have no idea. Remember you know what you are doing and have done. I cannot mind read.
. I suggest the following: Drop me a file off:


. Put some similar data in it similar to that which you did before (and note my comments in Post #62)

. Put ALL the codes in it… All your attempts and the copies of mine you have made.

. Then I will take a look when I get the time.

. Take your time as I cannot look in again today.

. But keep posting any info, or results of attempts you have done in the meantime. – So then I have a better idea how to help when I look in again.

. And maybe Google and read up a bit on UDFs and Public Functions. As I said a couple of times now

.

........
.
. So get the UDF up and running before you do anything else..
.
.........

. Maybe you have done that. But you hav’nt told me!!!!

. I will try and catch you tomorrow. Keep posting your progress in the meantime..

Alan.

 

[ArmyGuy45]

Am I able to use the previous User Defined Functions from the previous code you supplied for another project? All I have done is copy paste the code you provided me and ran it. I did not read the part where you said to configure a UDF before running the code so that would explain the error since it error on User Defined ArmyGeezerPickoutbits (UDArmyGeezerPickoutbits).

I copied and pasted your code last time without creating a UDF and it worked beautifully so I am wondering if the complexity of this marco requires one.

PS I am only 30 so I dunno if that would qualify me as a "geezer".

 

[DocAElstein]

Tried this and I got an error message, "Compile Error Sub or Function not defined"

And it highlighted the bold portion of the code:.........

Hi Metrics27..
. What are you actually trying to do?
. Note that copying from one sheet to another (with or without preserving Formulas etc.) is just a part of this Thread. The basic Theme of this Thread is filtering one main sheet and then copying that specific Filtered data to newly created sheets.
Alan

P.s. Just in case the above is your application, there are a few similar threads that may not be as obvious to catch with a search because of their title (And there are probably lots more also!!)
For example:

http://www.mrexcel.com/forum/excel-...lter-copy-paste-tabs-based-value-columna.html
http://www.mrexcel.com/forum/excel-...her-worksheet-if-column-=-specific-value.html
http://www.mrexcel.com/forum/excel-questions/799667-copying-row-based-coloumn-contents-2.html
http://www.mrexcel.com/forum/excel-...xcel-based-certain-criteria.html?#post3981936

 

[DocAElstein]

Hi Army man

Am I able to use the previous User Defined Functions from the previous code you supplied for another project…...

…. I don‘t quite understand. I have only done 2 UDF in my entire Life( At least only 2 that I understood and worked!!). Both I did yesterday.. One for you in this Thread and one in another Thread.
……If you mean if you can use my UDF in any other project. .. Yes ..that is one of the points you might have got if you had read what I wrote…..

…. All I have done is copy paste the code you provided me and ran it. I did not read the part where you said to configure a UDF before running the code so that would explain the error since it error on User Defined ArmyGeezerPickoutbits (UDArmyGeezerPickoutbits).

……...

.. Yep. !! That all makes sense then. (A UDF or Public Function is similar to a Sub. So a code in itself. So effectively all you needed to do was copy both those codes and paste them both in a normal module.( Or alternatively paste each in a separate normal module). So effectively I gave you 2 codes in Post #61. I just did not explain that well enough. But then the post would have been even longer and there would have been even more for you not to read!)

……copied and pasted your code last time without creating a UDF and it worked beautifully so I am wondering if the complexity of this marco requires one.

…

. There is no real answer to that I guess. What is complex? The point of any Functions is that they simplifier everything in the long run. Generally with VBA I am finding that The more you learn the “easier” you can do things. But then again that learning also takes time. It is very Difficult to make the right compromise. For everyone it is different. I am still learning and do not know what the right compromise is yet .. I mean how much to learn.
. Before yesterday I would have said using a UDF is making it more complex. But after a few hours of learning how to make them and use them I see it actually simplifies things a lot, makes debugging easier, gives you extra options etc..etc..!

…..

PS I am only 30 so I dunno if that would qualify me as a "geezer".

.. I cannot remember to be honest how a geezer is defined. I answer Threads to try to combine helping people and learning something myself. Sometime also as I write the codes I take the liberty of typing some rubbish just to amuse myself – it is always meant lighthearted - was no offence intended.


………………………………………………
. Anyways.. So ‘ow about this:

. Here are both those codes again from post #61. I Just present them here in one go. (That is to say in one MrExcel “Code Window”. (Which BTW as said by almost everyone here is probably the minimum of the available Thread Tools you should use when posting – see again my signature below..))..

. Simply copy everything there in one go and stick it in a module. Then when you run the first code
Sub ArmyGeezerUniqueSheet()
it should work. Because:- As I explained in post #61 the code
Sub ArmyGeezerUniqueSheet()
“calls” the second code
Public Function UDArmyGeezerPickOutBit(LongStrings As Range, StartString As String, StopString As String)
As it needs it (only once in this case).
. I cannot put it “simpler” than that. And it would be unwise for me to make it too simple. In my humble opinion I think You need to make some effort to understand the codes that you are using..

. I could and probably will when I get the time rewrite one code with everything in it. Just to compare. And I will open up the steps in the bit that picks out the string bit you want and put my green comments in it. That bit alone will probably then be bigger than the existing Code… So it will be incredibly long (…and “complicated…!”)……(That size might even make it impossible to post !)

Codes

[color=blue]Option[/color] [color=blue]Explicit[/color]
 
 
[color=blue]Sub[/color] ArmyGeezerUniqueSheet()
 
Application.ScreenUpdating = [color=blue]False[/color] [color=lightgreen]'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" And ws.Name <> "AnySheetYouWantToKeep" [color=blue]Then[/color]
        ws.Delete
        [color=blue]Else[/color] [color=lightgreen]'Presumably then the worksheet name is any one you want to keep 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]'End bit to make Temporary column[/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. As before unless if you need sort of validation (i.e. the value should only be within the range of a Byte/Integer) there's no point using anything but Long.-- 'saving' memory and using the smallest bit. But upon/after 32-bit, by all I have read, Integers (Short) need converted internally anyways, so a Long is actually faster.   http://www.mrexcel.com/forum/excel-questions/803662-byte-backward-loop-4.html[/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 [color=lightgreen]'Destination:=Worksheets(TempShtName).Range("A1") ', 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]
        Worksheets(TempShtName).Range("A1").PasteSpecial Paste:=xlPasteFormulas [color=lightgreen]'This is necerssary to "ensure" formulas are copied. Comment out Destination:= above if you out use this    http://www.mrexcel.com/forum/excel-questions/828241-visual-basic-applications-autofilter-specialcells-xlcelltypevisible-copy-only-values-not-formulas.html[/color]
        [color=lightgreen]'Worksheets(TempShtName).Range("A1").PasteSpecial Paste:=xlPasteAllUsingSourceTheme 'This is necerssary to "ensure" "everything" is copied. Comment out Destination:= above if you use  this    For example   http://www.excelforum.com/excel-new-users-basics/1063110-sheet-range-object-item-list-reorder.html[/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] [color=lightgreen]'Make everything visible in the First Master Sheet[/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]
 
[color=lightgreen]'[/color]
'
[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)
 
            [color=blue]Next[/color] y
        [color=blue]Next[/color] x
        UDArmyGeezerPickOutBit = vOut
 
[color=blue]End[/color] [color=blue]Function[/color] [color=lightgreen]'UDArmyGeezerPickOutBit[/color]

Alan..

P.s. If you don’t read all my Post this time.. The Bear Gets It!

 

[ArmyGuy45]

Doc,

Thanks for the update. I actually read your whole post this time, I swear!

I copy and pasted the code into my document and ran the marco. I am getting the error "Method 'Delete' of object '_Worksheet' failed". There is only 5 words of 'delete' in the code and one of them is explaining. Nothing from what I can see deals with deleting the worksheet but is it worksheets that gets deleted. Seems like a permission issue so my first thought that the document was protected or hidden. Not the case. I have no idea why it is giving the error.

 

[DocAElstein]

Doc,

Thanks for the update. I actually read your whole post this time, I swear!

I copy and pasted the code into my document and ran the marco. I am getting the error "Method 'Delete' of object '_Worksheet' failed". There is only 5 words of 'delete' in the code and one of them is explaining. Nothing from what I can see deals with deleting the worksheet but is it worksheets that gets deleted. Seems like a permission issue so my first thought that the document was protected or hidden. Not the case. I have no idea why it is giving the error.

. I think that bit is right at the start of the Macro. I delete all the sheets I think except for the master. So I guess there may be some protection issues. If you make sure when you start you do not have any sheets with the names of the final sheets that the macro will be making, then you can comment out that first bit and try that

 

[DocAElstein]

P.s.

. You were too late in replying... The bear got it -
. But he enjoyed every minute of it (He always does)

 

[ArmyGuy45]

Got that error cleared out. Thanks for pointing me in the right direction.

Now I am getting "Invalid procedure call or argument" but MVB is not highlighting where the error is ( which it normally does when you run debug ). Anyway to force which line is causing the error?

PS, I am lost on the bear thing. I know you have a bear in your avatar but I do not know if that is the reason for it.