Dim IDList As New Collection, lookupRange As Range, cell As Range
    Dim ws As Worksheet, wsCompany As Worksheet
    Dim wb As Workbook, ID As Variant
    If Me.CreateNewFile Then
        Dim filename As String
        filename = ThisWorkbook.Path & "\" & CStr(Me.cbxPeerGroup.Value) & "Peer.xls"
        ThisWorkbook.SaveCopyAs filename
        Set wb = Workbooks.Open(filename, False, False, , , , True)
    Else
        Set wb = ThisWorkbook
    End If
    Set ws = wb.Worksheets("PeerGroups")
    Set wsCompany = wb.Worksheets("Company")
    Dim tmp As String
    Set lookupRange = ws.Range("1:1").Find(what:=CStr(Me.cbxPeerGroup.Value), lookat:=xlWhole)
    Set lookupRange = lookupRange.EntireColumn.SpecialCells(xlCellTypeConstants)
    Set lookupRange = lookupRange.Offset( 1 ,  0 ).Resize(lookupRange.Rows.Count -  1 )
    On Error Resume Next
    For Each cell In lookupRange
        tmp = wsCompany.Range("B:B").Find(CStr(cell.Value), , , xlWhole).Offset( 0 , - 1 )
        IDList.Add tmp, tmp
    Next
    Set lookupRange = wsCompany.Range(wsCompany.Range("A2"), wsCompany.Range("A65536").End(xlUp))
    For Each cell In lookupRange
        On Error GoTo removeIfWhatWeNeed
        IDList.Add CStr(cell.Value), CStr(cell.Value)
        GoTo nxt
removeIfWhatWeNeed:
        IDList.Remove CStr(cell.Value)
        Err.Clear
        Resume Next
nxt:
    Next
    On Error GoTo  0 
    ' to make peer group
    Dim wsData As Worksheet
    Dim fRange As Range
    Dim toDel As Range
    Dim toDelTotal As Range
    Set wsData = wb.Worksheets("Data")
    Set fRange = wsData.Range("A1")
    For Each ID In IDList
        On Error Resume Next
        wsData.ShowAllData
        fRange.AutoFilter field:= 1 , Criteria1:=ID
        Set toDel = wsData.Range("A2:A65536").SpecialCells(xlCellTypeConstants).SpecialCells(xlCellTypeVisible)
        If toDelTotal Is Nothing Then
            Set toDelTotal = toDel
        Else
            Set toDelTotal = Union(toDelTotal, toDel)
        End If
    Next
    wsData.ShowAllData
    toDelTotal.EntireRow.Delete
    wb.Worksheets("Statistics").Range("D:IV").Delete
    wb.Worksheets("Statistics").Range("C:C").ClearContents
    wb.Worksheets("Statistics JF").Range("D:IV").Delete
    wb.Worksheets("Statistics JF").Range("C:C").ClearContents
    Unload Me