excel macro New sheeet if cell values are differen

Question

I have the below code that will look in column B and determine if the row should be copied to a new cell or if it should move to the next row down, based on the conditions. What I want it to do is to first look in column A, employee names, and if the name in say row k is not the same as in row k-1, then make a new sheet, copy row k to there and then loop around. Eventually, every employee has their own sheet.

Sub Sample()

Dim myarray

Dim wsInv As Worksheet
Dim rngDes As Range, rng As Range, cel As Range
Dim k As Long

Set wsInv = Thisworkbook.Sheets("Inventory")
Set rng = wsInv.Range("A2", wsInv.Range("A" & Rows.Count).End(xlup).Address)
Set rngDes = Thisworkbook.Sheets("Sheet3").Range("A3")

myarray = Array("CONSUMABLES", "FILTERS - BILLI TRIO", "FILTERS - ZIP GENERIC", _
    "GOODS", "HARDWARE FIXINGS", "LIGHTING - 50W DICHROIC", "LIGHTING - COMPACT BC/ES", _
    "LIGHTING - DICHROIC LAMP", "LIGHTING - FLURO", "LIGHTING - PLC LAMP 840/830", _
    "LIGHTING - PL-L", "LIGHTING - PULSE STARTER", "LIGHTING - STANDARD STARTER", _
    "LIGHTING - T5 FLURO", "NITROGEN CHARGE", "OXYGEN / ACETYLENE WELDING", _
    "R-134A", "R-22", "R-407C", "R-410A")

k = 0
For Each cel in rng
    If cel.Value = cel.Offset(-1,0).Value Then
        If Not IsError(Application.Match(cel.Offset(0,1).value, myarray, 0)) Then  
            cel.EntireRow.Copy rngDes.Offset(k,0)
            k = k + 1
        End If
    End If
Next cel`

If anyone could at least tell me where I can get to a new sheet based on column A value, that would be amazing, thank you

Answer 1

So if I read this right, then you want to have column A with employees, column B with something that you want to use to compare, and column C with inventory type. If that's the case, and if this table is sorted on the employees column, then the following modification to what you have should do the trick.

k = 0
Dim currentSheet as Worksheet, currentName as String
For Each cel in rng
    'So if column a contains names, 
    'and the name isn't what we have as the current name...
    If currentName <> cel.Value Then
         'reset your counter and your "currentSheet"
         k = 0
         Set currentSheet = ThisWorkbook.Sheets.Add
         currentSheet.Name = Left(rng.Value,31)
    End If
    'So as I read your original code, you had your search criteria in column
    'A. I am assuming employee name is now in column A and everything else
    'is shifted over, hence why the additional offset and why the other offset values 
    'have been changed
    If cel.Offset(,1).Value = cel.Offset(-1,1).Value Then
        If Not IsError(Application.Match(cel.Offset(0,2).value, myarray, 0)) Then  
            'This code also copies employee name, I don't know if that is 
            'desired or not. I am thinking if you don't need employee name,
            'the easiest thing to do would be to delete column A in the new sheets
            'in the above if block before you assign a new currentSheet
            cel.EntireRow.Copy currentSheet.Offset(k,1)
            k = k + 1
        End If
    End If
Next cel

If you can't sort by employees...then it is a little bit trickier. You'd have to add a function that searches through the sheet names to see if that sheet already exists, then find where you left off on that sheet, and then paste there. Its going to make your life a lot easier if you can sort.

Answer 2

As commented, try this:

   Sub Sample()

Dim myarray

Dim wsInv As Worksheet, wsDes As Worksheet
Dim rngDes As Range, rngEmp As Range, cel As Range

Set wsInv = ThisWorkbook.Sheets("Inventory")
Set rngEmp = wsInv.Range("A2", wsInv.Range("A" & Rows.Count).End(xlUp).Address)

myarray = Array("CONSUMABLES", "FILTERS - BILLI TRIO", "FILTERS - ZIP GENERIC", _
    "GOODS", "HARDWARE FIXINGS", "LIGHTING - 50W DICHROIC", "LIGHTING - COMPACT BC/ES", _
    "LIGHTING - DICHROIC LAMP", "LIGHTING - FLURO", "LIGHTING - PLC LAMP 840/830", _
    "LIGHTING - PL-L", "LIGHTING - PULSE STARTER", "LIGHTING - STANDARD STARTER", _
    "LIGHTING - T5 FLURO", "NITROGEN CHARGE", "OXYGEN / ACETYLENE WELDING", _
    "R-134A", "R-22", "R-407C", "R-410A")

For Each cel In rngEmp
    If Not IsError(Application.Match(cel.Offset(0, 1).Value, myarray, 0)) Then
        On Error Resume Next
        Set wsDes = ThisWorkbook.Sheets(cel.Value)
        On Error GoTo 0

        If wsDes Is Nothing Then Set wsDes = ThisWorkbook.Sheets.Add(after:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))

        wsDes.Name = cel.Value
        cel(1 - (cel.Row - 1)).EntireRow.Copy wsDes.Range("A1")
        cel.EntireRow.Copy wsDes.Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
        Set wsDes = Nothing
    End If
Next cel

End Sub

What above code does is check if value in Column B is within the array.
If yes, it will copy data to a Sheet named after the employee.
If that employee don't have an existing Sheet yet, it will create one.
Not sure if this helps, but give it a try.