Sorting membership list on multiple sheets

[chihb]

Hi,

I'm creating a membership list with fields: name, email, group, etc.

1. I want to have a master sheet where I enter new members and can test for duplicate entries on either the name or e-mail field. Ie as I type the text in a cell I can see if there is an existing cell in that column that is an exact match.

2. Additional sheets are created that automatically populate all row information about a specific group
Sheet 1=Master List; Sheet 2=All members that are part of group 1; Sheet 3=All members that are part of group 2

3. The additional sheets are populated based on data from the master list - and there are no blank rows. members of group 1 are on rows 1, 3, 9, 20.. etc. On Sheet 2 with members of group 1 there are no blank rows.

Thanks for any help on this!

 

[mrshl9898]

Add this to the Master Sheet

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim KeyCells As Range
    Set KeyCells = Range("A:C")

On Error GoTo ErrorHandler
If Not Application.Intersect(KeyCells, Range(Target.Address)) _
           Is Nothing Then

If Target.Column = 1 Then
    mystr = Target.Value
    mycount = Application.WorksheetFunction.CountIf(Range("A:A"), mystr)

    If mycount > 1 Then
    answer = MsgBox("Value already exists, do you wish to continue?", vbQuestion + vbYesNo + vbDefaultButton2)
    
        If answer = vbYes Then
        Else
        Target.ClearContents
        End If
        
    End If
End If

If Target.Column = 2 Then
    mystr = Target.Value
    mycount = Application.WorksheetFunction.CountIf(Range("B:B"), mystr)

    If mycount > 1 Then
    answer = MsgBox("Value already exists, do you wish to continue?", vbQuestion + vbYesNo + vbDefaultButton2)
    
        If answer = vbYes Then
        Else
        Target.ClearContents
        End If
        
    End If
End If

If Target.Column = 3 Then
addgroup
End If

End If

ErrorHandler:
End Sub

And insert a module with this:

Public mygroup As String
Public sht As Worksheet
Public LastRow As Long
Public worksh As Integer
Public worksheetexists As Boolean
Public sht2 As Worksheet
Public LastRow2 As Long

Sub addgroup()

Set sht = ActiveSheet

LastRow = sht.Cells(sht.Rows.Count, "C").End(xlUp).Row
mygroup = sht.Cells(LastRow, 3).Value
insertworksheet

End Sub


Sub insertworksheet()

    worksh = Application.Sheets.Count
    worksheetexists = False
    For x = 1 To worksh
        If Worksheets(x).Name = mygroup Then
            worksheetexists = True
            Sheets(mygroup).Activate
            Exit For
        End If
    Next x
    If worksheetexists = False Then
        Worksheets.Add after:=Worksheets(Worksheets.Count)
        ActiveSheet.Name = mygroup
        sht.Rows(1).Copy ActiveSheet.Rows(1)
    End If
   
Set sht2 = ActiveSheet
LastRow2 = sht2.Cells(sht2.Rows.Count, "A").End(xlUp).Row
sht.Rows(LastRow).Copy sht2.Rows(LastRow2 + 1)
   
End Sub