I THINK a worksheet change event is in order, but there might be a better way

[zookeepertx]

Hi there!

A co-worker has a workbook to keep track of employees' HazMat training classes. When she adds a new employee to the list, their data gets highlighted green, lavendar or blue, depending on what region they're in.

The master sheet is called HazMat Training and there are 3 more tabs, one for each region. For sheet 2, which is named Northeast, the tab is colored green, for sheet 3 the tab is colored lavendar, for sheet 4 the tab is colored blue.

When she creates a new entry on the HazMat Training sheet, what she would like to happen is, whatever color she highlights their row, for that row of data to also appear on the correspondingly colored tab. (All columns are the same on all 4 sheets, so just being copied and pasted would work fine).

I've searched all over for worksheet change coding and what I'm finding all seems to be geared to calculating something or find information or something. I haven't seen anything to copy/paste an entire row to another sheet, and certainly not to a specific sheet depending on cell color/tab color.

Is this even possible? If so, I would be so happy to learn how!

Thanks!

Jenny

 

[Eric W]

Try this version:

Private Sub Worksheet_Deactivate()
Dim Regions As Variant, i As Long, r As Long, r2 As Long, FindCell As Range

    Regions = Array("Northeast", "South", "West")
    
    For r = 2 To Cells(Rows.Count, "A").End(xlUp).Row
        For i = 0 To UBound(Regions)
            If Cells(r, "A").Interior.Color = Sheets(Regions(i)).Tab.Color Then
                Set FindCell = Sheets(Regions(i)).Columns("B:B").Find(Cells(r, "B"))
                If FindCell Is Nothing Then
                    r2 = Sheets(Regions(i)).Cells(Rows.Count, "A").End(xlUp).Row + 1
                    If WorksheetFunction.CountIf(Sheets(Regions(i)).Columns("E:E"), Cells(r, "E")) > 0 Then
                        r2 = Evaluate("LOOKUP(2,1/(" & Sheets(Regions(i)).Range("E1").Resize(r2).Address(1, 1, 1, 1) & _
                                    "&""""=""" & Cells(r, "E") & """),ROW(E1:E" & r2 & "))")
                        Sheets(Regions(i)).Rows(r2 + 1).Insert
                    End If
                    Range("A1:K1").Offset(r - 1).Copy Sheets(Regions(i)).Range("A1:K1").Offset(r2)
                End If
                Exit For
            End If
        Next i
    Next r
    
End Sub

No sorting. It checks for the color, then it checks to see if the associate is already there, then it looks for the store number, then it adds the new row after the last row of the store. It will add the row to the end if the store number is not found.

Let me know how this works.

 

[zookeepertx]

(Sorry, I've been off for a few days)

Perfect! Seems to work beautifully; you're a genius! I honestly wasn't even sure if this could be done, but you rock!

Thank you so much!

Jenny

 

[Eric W]

Glad it works for you!