StackOverflow2013

Note that there are some explanatory texts on larger screens.

plurals

PO
text
Body
copied!<p>Before attempting to respond to this question, I would like to write what I believe you are trying to accomplish; when you confirm this is what you are trying to do, I will try to help you get working code to achieve it. This would normally be done with comments, but the threads of comments so far are a bit disjointed, and the code is quite complex...</p> <ol> <li>You have data in a sheet (called "sheet1" - it might be something else though)</li> <li>The first column contains certain values that might be repeated</li> <li>You don't know how many columns there might be... you would like to know that though</li> <li>You attempt to find each unique value in column A (call it the "key value"), and display it (one at a time) in a message box. This looks more like a debug step than actual functionality for the final program.</li> <li>You then turn on the autofilter on column A; selecting only rows that match a certain value</li> <li>Using that same value as the name of a sheet, you see if such a sheet exists: if it does, you clear its contents; if it does not, then you create it at the end of the workbook (and give it the name of the key)</li> <li>You select all rows with the same (key) value in column A on sheet1, and copy them to the sheet whose name is equal to the value in column A that you filtered on</li> <li>You want to repeat step 5-8 for each of the unique (key) values in column A</li> <li>When all is done, I believe you have (at least) one more sheet than you had key values in column A (you also have the initial data sheet); however you do not delete any "superfluous" sheets (with other names). Each sheet will have only rows of data corresponding to the current contents of sheet1 (any earlier data was deleted).</li> <li>During the operation you turn autofiltering on and off; you want to end up with auto filter disabled.</li> </ol> <p>Please confirm that this is indeed what you are attempting to do. If you could give an idea of the format of the values in column A, that would be helpful. I suspect that some things could be done rather more efficiently than you are currently doing them. Finally I do wonder whether the whole purpose of organizing your data in this way might be to organize the data in a specific way, and maybe do further calculations / graphs etc. There are all kinds of functions built in to excel (VBA) to make the job of data extraction easier - it's rare that this kind of data rearranging is necessary to get a particular job done. If you would care to comment on that...</p> <p>The following code does all the above. Note the use for <code>For Each</code>, and functions / subroutines to take care of certain tasks (<code>unique</code>, <code>createOrClear</code>, and <code>worksheetExists</code>). This makes the top level code much easier to read and understand. Also note that the error trapping is confined to just a small section where we check if a worksheet exists - for me it ran without problems; if any errors occur, just let me know what was in the worksheet since that might affect what happens (for example, if a cell in column <code>A</code> contains a character not allowed in a sheet name, like <code>/\!</code> etc. Also note that your code was deleting "CurrentRegion". Depending on what you are trying to achieve, "UsedRange" <em>might</em> be better...</p> <pre><code>Option Explicit Sub Solution() Dim shData As Worksheet Dim nameRange As Range Dim r As Range, c As Range, A1c As Range, s As String Dim uniqueNames As Variant, v As Variant Set shData = Sheets("Sheet1") ' sheet with source data Set A1c = shData.[A1] ' first cell of data range - referred to a lot... Set nameRange = Range(A1c, A1c.End(xlDown)) ' find all the contiguous cells in the range ' find the unique values: using custom function ' omit second parameter to suppress dialog uniqueNames = unique(nameRange, True) Application.ScreenUpdating = False ' no need for flashing screen... ' check if sheet with each name exists, or create it: createOrClear uniqueNames ' filter on each value in turn, and copy to corresponding sheet: For Each v In uniqueNames A1c.AutoFilter Field:=1, Criteria1:=v, _ Operator:=xlAnd A1c.CurrentRegion.Copy Sheets(v).[A1] Next v ' turn auto filter off A1c.AutoFilter ' and screen updating on Application.ScreenUpdating = True End Sub Function unique(r As Range, Optional show) ' return a variant array containing unique values in range ' optionally present dialog with values found ' inspired by http://stackoverflow.com/questions/3017852/vba-get-unique-values-from-array Dim d As Object Dim c As Range Dim s As String Dim v As Variant If IsMissing(show) Then show = False Set d = CreateObject("Scripting.Dictionary") ' dictionary object will create unique keys ' have to make it case-insensitive ' as sheet names and autofilter are case insensitive For Each c In r d(LCase("" & c.Value)) = c.Value Next c ' the Keys() contain unique values: unique = d.Keys() ' optionally, show results: If show Then ' for debug, show the list of unique elements: s = "" For Each v In d.Keys s = s & vbNewLine & v Next v MsgBox "unique elements: " & s End If End Function Sub createOrClear(names) Dim n As Variant Dim s As String Dim NewSheet As Worksheet ' loop through list: add new sheets, or delete content For Each n In names s = "" & n ' convert to string If worksheetExists(s) Then Sheets(s).[A1].CurrentRegion.Clear ' UsedRange might be better...? Else With ActiveWorkbook.Sheets Set NewSheet = .Add(after:=Sheets(.Count)) NewSheet.Name = s End With End If Next n End Sub Function worksheetExists(wsName) ' adapted from http://www.mrexcel.com/forum/excel-questions/3228-visual-basic-applications-check-if-worksheet-exists.html worksheetExists = False On Error Resume Next worksheetExists = (Sheets(wsName).Name <> "") On Error GoTo 0 End Function </code></pre>

Querying!

Guidance

An individual column

Larger individual text columns get their own page to allow for proper reading.

SQuiL has stopped working due to an internal error.

If you are curious you may find further information in the browser console, which is accessible through the devtools (F12).

Reload