Creating different sheets from data in the first sheet,

[Jo4x4]

Hi everybody! I have a very simple spreadsheet with all the data in sheet 1. I would like to split that data into different sheets. I tried vlookup, and can find the first match, but no second or third match.

Potholes	2/5/2017 <colgroup><col width="101" style="width:76pt"> </colgroup><tbody> </tbody>	John
Streetlights	8/6/ 2017	Peter
Water leaks	3/4/2017	Dave
Potholes	1/6/2017	Adam
Potholes	3/2/2017	Pete

<tbody>
</tbody>

I then want sheets named "Potholes", "Streetlights", "Water Leaks" with the Pothole sheet containing the 3 instances and names.


Thanks a stack in advance!

Jo

Windows 7, Excel 2007

 

[Fluff]

OK, thanks for the file, a few things that you need to do as follows
1) delete all the extra sheet so that only the 2017 sheet remains.
2) in the VBE select insert > Module then remove the code from the sheet module & paste it into the new module 1
3) right click the button2 > Assign macro & select ShtFltrCopy (this needs to be done as the macro has been moved in part 2) )
4) Select the developer tab > Macro security > Trusted Locations > If the location of the file is not in the list add it.
5) Save & close, then reopen it & click Button 2
Hopefully this will solve the problems.

 

[Jo4x4]

Thanks a stack Fluff!!! Working like a charm. Any way to keep my main sheet to the far left?

Thanks again
Jo

 

[Jo4x4]

Oops, just ran into a snag. It created all the sheets, but as soon as I add any info it gives the 400 error again. I am going to be adding people all the time, and occasionally another type of Column A.

 

[Fluff]

OK delete the code you have & replace with this

Option Explicit

Sub ShtFltrCopy()

    Dim Dict As Object
    Dim Ky As Variant
    Dim Cl As Range
    Dim UsdRws As Long
    Dim Ws As Worksheet

Application.ScreenUpdating = False
    Set Dict = CreateObject("scripting.dictionary")

    With Sheets("2017")
        UsdRws = .Range("A" & Rows.Count).End(xlUp).Row
    
        For Each Cl In .Range("A2:A" & UsdRws)
            If Not Dict.exists(Cl.Value) Then Dict.Add Cl.Value, Nothing
        Next Cl
    
        For Each Ky In Dict.keys
            If ShtExists(Left(Ky, 31)) Then
                Set Ws = Sheets(Left(Ky, 31))
                Ws.Cells.Clear
                .Range("A1").AutoFilter Field:=1, Criteria1:=Ky
                .Range("A1:C" & UsdRws).SpecialCells(xlVisible).Copy Ws.Range("A1")
            Else
                Set Ws = Worksheets.Add(after:=Sheets(1))
                Ws.Name = Left(Ky, 31)
                .Range("A1").AutoFilter Field:=1, Criteria1:=Ky
                .Range("A1:C" & UsdRws).SpecialCells(xlVisible).Copy Ws.Range("A1")
            End If
        Next Ky
        .AutoFilterMode = False
    End With
    Sheets("2017").Activate

End Sub

Function ShtExists(ShtNme As String, Optional Wbk As Workbook) As Boolean

    If Wbk Is Nothing Then Set Wbk = ThisWorkbook
    On Error Resume Next
    ShtExists = (LCase(Wbk.Sheets(ShtNme).Name) = LCase(ShtNme))
    On Error GoTo 0

End Function

If a sheet already exists, this will clear the sheet & then add the info, if a sheet doesn't exist, then it will be added.

 

[Jo4x4]

I don't know how to thank you for your help. Clearly, this is way beyond my scope of knowledge. When I added a name to an existing column A "problem", it ran the debugger and highlighted The following after the Else command: WS.Name=Left(KY,31). It also created a new sheet with a number.

 

[Fluff]

What was the new value?

 

[Jo4x4]

It also creates Filter buttons next to the header row headings...

It was just a name with "water" in Column A.

 

[Jo4x4]

Ok, found the problem: One of the names did not have a "problem" Column A. As soon as I rectified that, it is working great! Thanks again!!!!

 

[Fluff]

Glad you got it sorted

 

[Jo4x4]

Not so lucky. As soon as I put all the data in, it gives the same WS error. I realize that I have not yet changed the parameters to include all the columns, but it should copy the first three columns?

Sorry for the hassles. Here is the complete file: https://drive.google.com/file/d/0B18Q7ZeBjgQhSHlXcGNrSF84MzA/view?usp=sharing

Thanks