Create a unique dynamic List on separate worksheet (based on CF)

[drewberts]

I have a list of all our projects (they run as sequential numbers 0100 to 9999) in column A. In column B I enter the same project number when it has been archived and in Column C I have a formula which subtracts B from A - the answer is 0 when the 2 numbers match (I just use this as a check so I can easily see if I enter a number wrong).

I have CF of column A which turns the project number red if there is no entry in column B (so I can easily see which numbers haven't been archived). This is all fine.

On a separate sheet i want to create a dynamic unique list of all the numbers that haven't been archived. I'm thinking I can either do this based on the CF or based on those that have no value in column B. I'm happy either way but I need the list to update dynamically as I add archived numbers to column B in my first sheet. The second sheet is so I can see which numbers (at a glance) I need to archive.

I think I need a dynamic range using OFFSET function but I'm not sure how to apply a criteria to "filter" the list. Any guidance would be appreciated.

Hope this makes sense.

 

[Fluff]

Hia
How about

Private Sub Worksheet_Change(ByVal Target As Range)

    With Target
        If .Count <> 1 And .Column <> 2 Then Exit Sub
    End With
    
    Sheets("[COLOR=#0000ff]List[/COLOR]").Cells.Clear
    With Columns(2).SpecialCells(xlCellTypeBlanks)
        .Offset(, -1).Copy Sheets("[COLOR=#0000ff]List[/COLOR]").Range("A1")
    End With
    
End Sub

This needs to go into the sheet module, and you'll need to change the sheet name in blue to match

 

[drewberts]

Thanks Fluff - it works in principle but needs to sit within an already formatted summary sheet, so clearing the sheet is a problem

 

[Fluff]

Where in the summary sheet does it need to go?
Also we'll need to clear some of the data, so what range can we clear?

 

[drewberts]

Hi Fluff - its a little more complicated than I first explained as I can usually work out how to expand the solution to fit my problem (maybe not this time )

The sheet that has the project numbers listed is actual one of 10 sheets. Sheet 1 has Job Nos 0000-9999, Sheet 2 has 1000-1999, Sheet 3 has 2000-2999 etc up to sheet 10 which has 10000-10999

My idea was to have a summary sheet with 10 columns each reporting the missing projects for each sheet. Column A (starting at Row 6 would show the dynamic list for those on sheet 1, column B for those on sheet 2 etc.

 

[Fluff]

Ok try this

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)

    Dim ShtNum As Integer

    If Sh.Name = "[COLOR=#0000ff]Summary[/COLOR]" Then Exit Sub
    With Target
        If .Count <> 1 And .Column <> 2 Then Exit Sub
    End With

    ShtNum = Right(Sh.Name, 1)
    With Sheets("[COLOR=#0000ff]Summary[/COLOR]")
        .Range(.Cells(6, ShtNum), .Cells(6, ShtNum).End(xlDown)).Clear
    End With
    With Sh.Columns(2).SpecialCells(xlCellTypeBlanks)
        .Offset(, -1).Copy Sheets("summary").Cells(6, ShtNum)
    End With

End Sub

This needs to go into the ThisWorkbook module. Please delete the sheet code I gave initially, before running this

 

[drewberts]

Thanks for your time Fluff. I've added the code to the This workbook module but nothing happens (I see its on a SheetChange event) but still nothing happens). I don't know enough about VBA code to decipher what the code is trying to do.

 

[Fluff]

Ok
You said

Sheet 1 has Job Nos 0000-9999, Sheet 2 has 1000-1999, Sheet 3 has 2000-2999 etc

are these the actual names of the sheets? Also are you manually adding the numbers in column B?

 

[drewberts]

Sheets are called :-

0000-9999
1000-1999
2000-2999
3000-3999
4000-4999
5000-5999
6000-6999
7000-7999
8000-8999
9000-9999
10000-10999

I manually type into Col B

 

[Fluff]

How about this

Option Explicit
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)

    Dim ColNum As Integer
    
Application.EnableEvents = False

On Error GoTo Xit
    If Sh.Name = "Summary" Then Exit Sub
    With Target
        If .Count <> 1 And .Column <> 2 Then Exit Sub
    End With

'    ColNum = Right(Sh.Name, 1)
    Select Case Sh.Name
        Case Is = "0000-9999"
            ColNum = 1
        Case Is = "1000-1999"
            ColNum = 2
        Case Is = "2000-2999"
            ColNum = 3
        Case Is = "3000-3999"
            ColNum = 4
        Case Is = "4000-4999"
            ColNum = 5
        Case Is = "5000-5999"
            ColNum = 6
        Case Is = "6000-6999"
            ColNum = 7
        Case Is = "7000-7999"
            ColNum = 8
        Case Is = "8000-8999"
            ColNum = 9
        Case Is = "9000-9999"
            ColNum = 10
        Case Is = "10000-10999"
            ColNum = 11
    End Select
    With Sheets("Summary")
        .Range(.cells(6, ColNum), .cells(6, ColNum).End(xlDown)).Clear
    End With
    With Sh.Columns(2).SpecialCells(xlCellTypeBlanks)
        .Offset(, -1).Copy Sheets("summary").cells(6, ColNum)
    End With
Application.EnableEvents = True

Exit Sub

Xit:
Application.EnableEvents = True
MsgBox "This macro has encoutered a problem & quit"

End Sub