Iterate through cells in a column, if contains criteria, copy row to new sheet

[dumboltar]

I have a spreadsheet similar to the following:


<pre>
<b>Name Title ID</b>
Person 1 Title 1 1
Person 2 Title 2 11
Person 3 Title 3 111
Person 4 Title 4 1111
Person 5 Title 5 12
Person 6 Title 6 121
Person 7 Title 7 1211
Person 8 Title 8 1212
Person 9 Title 9 122
Person 10 Title 10 13
Person 11 Title 11 131
Person 12 Title 12 1311
Person 13 Title 13 1312
Person 14 Title 14 13121
Person 15 Title 15 1313
Person 16 Title 16 132
Person 17 Title 17 1321
Person 18 Title 18 14
Person 19 Title 19 15
Person 20 Title 20 151
Person 21 Title 21 1512
</pre>


I want to iterate through each cell in the "ID" column.
If the column contains a value, then copy the entire row to a new sheet.


Here's the tricky part:
<pre>
- The first number will always start with 1.
- I want the script to search "ID" for 1 + another single digit (10,11,12,13...).
For all cells that match the criteria copy that row to a new sheet.
- When that is done, now search for 11 + another single digit (111,112,113,114...).
- When that is done, now search for 12 + another digit (121,122,123,124...)
</pre>


This should keep going:
<pre>
Search "ID" for: Finds all:
19 191, 192, 193, 194...
124 1241, 1242, 1243, 1244...
1111 11111, 11112, 11113, 11114, 11115...
1127 11271, 11272, 11273, 11274...
12345 123451, 123452, 123453, 123454, 123455...
</pre>


The preceding digits before the '+ another single digit' dictate what sheet it should go in.
<pre>
- If search for 1 + another single digit - these should all go on a single sheet.
- If searching for 11 + another single digit - these should go on a single sheet.
- If search for 1234 + another single digit - these should go on a single sheet.
- So on and so forth.
</pre>


Any help is greatly appreciated and thank you in advance!

 

[portews]

I wasn't exactly sure what you wanted to do with the finds, but this code will copy them into a worksheet by the number of characters in the ID number, for example; 123 has 3 characters so it will be copied to new sheet called "3". 1234 is four characters long, so it will be copied to a new sheet called "4".

Function CreateSheetIf(strSheetName As String) As Boolean
'creates a new sheet if it doesn't exist
'http://www.ozgrid.com/forum/showthread.php?t=53141
Dim wsTest As Worksheet
CreateSheetIf = False
 
Set wsTest = Nothing
On Error Resume Next
Set wsTest = ActiveWorkbook.Worksheets(strSheetName)
On Error GoTo 0
 
If wsTest Is Nothing Then
    CreateSheetIf = True
    Worksheets.Add.Name = strSheetName
    Sheets(strSheetName).Move After:=Sheets(Sheets.Count)
End If
     
End Function
' finds the last row in a given sheet
Function LastRow(sht As String) As Long
LastRow = Sheets(sht).Cells(Rows.Count, "A").End(xlUp).Row
End Function


Sub parseIDs()
Dim sht As String
Dim Length As String
sht = "Sheet1"
For i = 2 To LastRow(sht)                                 'start at row 2 to the last row
    Length = CStr(Len(Sheets(sht).Cells(i, 3)))    'find the length of the ID
    CreateSheetIf (Length)                                 'see if the worksheet exists, if not, create it.
    Sheets(sht).Rows(i).EntireRow.Copy _            'copy the entire row to the last row of the length sheet
        Destination:=Sheets(Length).Cells(LastRow(Length) + 1, 1)
Next
End Sub

 

[dumboltar]

Thanks Portews! I appreciate the response.

Copying by length isn't quite what I need.

If I'm searching for 12 + any single number - this should go on one sheet.
Then the next step will be search for 13 + single number - and this will go on a different sheet.

In both of those instances the length will be 3, but they will go on different sheets.

If we keep going, I will want to search for:
1234 + any single number - will go on its own sheet, then
1235 + any single number - will go on its own sheet,
so on and so forth.

I trying to think through how to do it, but I can't quite wrap my head around it

 

[dumboltar]

Here's how I did it for anyone interested:

Set mainSht = Worksheets("Sheet1")  ' Copy From this sheet


'Find the last row with data in specified column.
LR = mainSht.Cells(Rows.Count, "F").End(xlUp).Row


Set LRange = mainSht.Range("F2:F" & LR)


'Find max number in the range
max = Application.WorksheetFunction.max(LRange)


    
'Look at every cell in cpecified column
For Each Cell In LRange
 For i = 1 To 1111
    cIndex = CStr(i)
    If Cell.Value Like "1" + cIndex + "?" Then    'check to See if C equals value
                        
        
        sheetName = "1" + cIndex
                  
        'Check if worksheet exists
        Set wsCheck = Nothing
        On Error Resume Next
        Set wsCheck = ActiveWorkbook.Worksheets(sheetName)
        On Error GoTo 0
        
        'If worksheet does not exist, create new
        If wsCheck Is Nothing Then
            Worksheets.Add(After:=ActiveWorkbook.Sheets(ActiveWorkbook.Sheets.Count)).Name = sheetName
        End If
   
Set Pastesheet = Worksheets(sheetName)  ' Paste to this sheet
            Cell.EntireRow.Copy  ' Copy the row
            Pastesheet.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValuesAndNumberFormats
    End If
    Next
          
Next Cell  ' Now we check the next cell in chosen column

 

[portews]

Turns out it was just a small change in code from what I had. The only question still for me is what to do with the single 1. In this case I put it in the 1 sheet. Change the 1 in the line If Length = "" then Length = 1

Sub parseIDs()
'http://www.mrexcel.com/forum/excel-questions/895740-iterate-through-cells-column-if-contains-criteria-copy-row-new-sheet.html
Dim sht As String
Dim Length As String
sht = "Sheet1"
For i = 2 To LastRow(sht)
    Length = Left(Sheets(sht).Cells(i, 3), Len(Sheets(sht).Cells(i, 3)) - 1)
    If Length = "" Then Length = 1
    CreateSheetIf (Length)
    Sheets(sht).Rows(i).EntireRow.Copy _
        Destination:=Sheets(Length).Cells(LastRow(Length) + 1, 1)
Next
End Sub