FIND SPECIFIC AND CUT IN ANOTHER SHEET

[michellin]

Hi there,

I'm working on a sheet for my truck, i have done the basic macros with my knowing and recording of macro's. But now i'm stuck...

I'm working on excel 2016 pro

What i'm trying to do :

I got a worksheet of stock in my truck like an inventory, the size and count are variable always(could be 100 entries or 168, it's always depend).

On my sheet 3 in column O i got variable like electricity, paper, tools etc. That column never have the same number of entries(in variable and length).

I need to find all electricity and cut them(all the row) into a new sheet name electricity(create the new sheet at firts) and paste it from line 2 to the bottom(line 1 is the header, from sheet 4 line 1), and doing it for every variable in the column O sometimes it can be only 3 variables sometimes he cant be 12 variables. So i need the macro to sort them all and extract them to another sheet with their name.

I try to learn the row count method, but i think it really too much advance for me now. I hope i'm clear in my explanation.

If you have any question just ask me and i will try to make it clear. Thanks in advance for your help so much.

Francois

 

[sijpie]

The code below is quite advanced. But if you read the comments and try to understand what each line is doing, you will learn quickly to improve your code.
In my tag line below there is also a link to a handy guide to these techniques.

Option Explicit 'always start your vba module with this line, to force correct use of declaring variables

Sub SplitInventory()
    Dim vInv As Variant, vOut As Variant
    Dim lRi As Long, lC As Long, lRo As Long, UB1 As Long, UB2 As Long, lColOffs As Long
    Dim sItem As String
    Dim colItems As Collection
    Dim wsOut As Worksheet, wsInv As Worksheet
    Dim rInv As Range
    Dim iItemCount As Integer
    'notice in the declarations above, that each variable starts with a letter telling the type of variable
    
    Set colItems = New Collection
    
    Set wsInv = Sheets("Sheet3")    '<<<<< set sheet name to correct sheet where inventory table is held
    Set rInv = wsInv.Range("A1")    '<<<<< set cell name to top left cell (header row) of inventory table
    
    'read the inventory table into an array for fast processing. An array is like a fast spreadsheet held in memory
    vInv = rInv.CurrentRegion.Value
    'store the number of rows and columns of the array
    UB1 = UBound(vInv, 1)
    UB2 = UBound(vInv, 2)
    
    'calculate which column is column O in case the first column is not A
    lColOffs = Range("O1").Column - rInv.Column + 1
    
    'To get all the unique categories in column O, use a collection
    On Error Resume Next    'trying to add a duplicate key to a collection will result in error. Tell VBA to ignore error
    For lRi = 2 To UB1
        colItems.Add Item:=vInv(lRi, lColOffs), Key:=vInv(lRi, lColOffs)
    Next lRi
    On Error GoTo 0         'always reset the error behaviour once no longer needed.
    'The collection now only holdsthe unique categories
    
    'Loop through the categories in the collection _
     create a sheet for each (after deleting an existing sheet with same name) _
     and then fill it withthe rows for that category
    
    Application.DisplayAlerts = False   'don't display warning if sheet exists and is to be deleted
    Application.ScreenUpdating = False  'don't update the screen until finished - no flickering and faster
    
    For iItemCount = 1 To colItems.Count
    
        sItem = colItems.Item(iItemCount)
        On Error Resume Next    'trying to set to a non existing sheet will result in error. Tell VBA to ignore error
        Set wsOut = Sheets(sItem)
        On Error GoTo 0
        If Not wsOut Is Nothing Then    'sheet exists. Delete to create new
            wsOut.Delete
        End If
        Set wsOut = Sheets.Add(after:=Sheets(Sheets.Count))
        
        'Now build output table. For ease of programming use same amout of rows as inventory table
        ReDim vOut(1 To UB1, 1 To UB2)
        'copy header row
        For lC = 1 To UB2
            vOut(1, lC) = vInv(1, lC)
        Next lC
        lRo = 2     'set lRo to the first row of the output array to be filled (row 1 contains the header)
        'now search for the relevant rows and copy those
        For lRi = 2 To UB1
            If vInv(lRi, lColOffs) Like sItem Then  'the 'Like' operator is a comparison operator which for strings _
                                                     is much faster then '=' (and you can use wildcards)
                'copy this row
                For lC = 1 To UB2
                    vOut(lRo, lC) = vInv(lRi, lC)
                Next lC
                'increment the output row
                lRo = lRo + 1
            End If
        Next lRi
        
        'the output array now contains all the rows for the item _
         so dump it to the created sheet
        With wsOut
            .Name = sItem
            .Range("A1").Resize(UB1, UB2).Value = vOut
        End With
    Next iItemCount
    
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
End Sub

 

[michellin]

The code below is quite advanced. But if you read the comments and try to understand what each line is doing, you will learn quickly to improve your code.
In my tag line below there is also a link to a handy guide to these techniques.

Option Explicit 'always start your vba module with this line, to force correct use of declaring variables

Sub SplitInventory()
    Dim vInv As Variant, vOut As Variant
    Dim lRi As Long, lC As Long, lRo As Long, UB1 As Long, UB2 As Long, lColOffs As Long
    Dim sItem As String
    Dim colItems As Collection
    Dim wsOut As Worksheet, wsInv As Worksheet
    Dim rInv As Range
    Dim iItemCount As Integer
    'notice in the declarations above, that each variable starts with a letter telling the type of variable
   
    Set colItems = New Collection
   
    Set wsInv = Sheets("Sheet3")    '<<<<< set sheet name to correct sheet where inventory table is held
    Set rInv = wsInv.Range("A1")    '<<<<< set cell name to top left cell (header row) of inventory table
   
    'read the inventory table into an array for fast processing. An array is like a fast spreadsheet held in memory
    vInv = rInv.CurrentRegion.Value
    'store the number of rows and columns of the array
    UB1 = UBound(vInv, 1)
    UB2 = UBound(vInv, 2)
   
    'calculate which column is column O in case the first column is not A
    lColOffs = Range("O1").Column - rInv.Column + 1
   
    'To get all the unique categories in column O, use a collection
    On Error Resume Next    'trying to add a duplicate key to a collection will result in error. Tell VBA to ignore error
    For lRi = 2 To UB1
        colItems.Add Item:=vInv(lRi, lColOffs), Key:=vInv(lRi, lColOffs)
    Next lRi
    On Error GoTo 0         'always reset the error behaviour once no longer needed.
    'The collection now only holdsthe unique categories
   
    'Loop through the categories in the collection _
     create a sheet for each (after deleting an existing sheet with same name) _
     and then fill it withthe rows for that category
   
    Application.DisplayAlerts = False   'don't display warning if sheet exists and is to be deleted
    Application.ScreenUpdating = False  'don't update the screen until finished - no flickering and faster
   
    For iItemCount = 1 To colItems.Count
   
        sItem = colItems.Item(iItemCount)
        On Error Resume Next    'trying to set to a non existing sheet will result in error. Tell VBA to ignore error
        Set wsOut = Sheets(sItem)
        On Error GoTo 0
        If Not wsOut Is Nothing Then    'sheet exists. Delete to create new
            wsOut.Delete
        End If
        Set wsOut = Sheets.Add(after:=Sheets(Sheets.Count))
       
        'Now build output table. For ease of programming use same amout of rows as inventory table
        ReDim vOut(1 To UB1, 1 To UB2)
        'copy header row
        For lC = 1 To UB2
            vOut(1, lC) = vInv(1, lC)
        Next lC
        lRo = 2     'set lRo to the first row of the output array to be filled (row 1 contains the header)
        'now search for the relevant rows and copy those
        For lRi = 2 To UB1
            If vInv(lRi, lColOffs) Like sItem Then  'the 'Like' operator is a comparison operator which for strings _
                                                     is much faster then '=' (and you can use wildcards)
                'copy this row
                For lC = 1 To UB2
                    vOut(lRo, lC) = vInv(lRi, lC)
                Next lC
                'increment the output row
                lRo = lRo + 1
            End If
        Next lRi
       
        'the output array now contains all the rows for the item _
         so dump it to the created sheet
        With wsOut
            .Name = sItem
            .Range("A1").Resize(UB1, UB2).Value = vOut
        End With
    Next iItemCount
   
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
End Sub

OMG dam it's too advance for me for sure, but i really like all the comment, i can learn from it, that super cool. And it's working like a charm.

Thanks for the help, that fantastic