create list based on criteria

[Lucianp]

I want to create a short list based on the condition within a larger list.

On sheet 1, I have a list of variable length. column A holds the names that I want to copy. Column B holds a number, 1,2 or 3.

I want to copy the names from Sheet 1, column A ,if the corresponding cell in column B is equal to 1, into sheet 2 column A.

I have to copy it to a separate list as this will be the basis for a graph. This worksheet will be for use by others but they will only be able to edit the list in sheet 1.

I tried to do this several different ways but I think I'm going down the wrong track.

any ideas please.

 

[venkat1926]

hope I have understtod your query
do autofilter for column B =1
copy the fitlered litst

 

[dafan]

Try this. I've made it in a button routine, which might be the easiest.

Private Sub CommandButton1_Click()
LastRow = Sheets("Sheet1").Range("A65536").End(xlUp).Row
    For i = 1 To LastRow
        If Range("B" & i).Value = 1 Then
            LastRow2 = Sheets("Sheet2").Range("A65536").End(xlUp).Row + 1
            Sheets("Sheet2").Range("A" & LastRow2).Value = Sheets("Sheet1").Range("A" & i)
        End If
    Next i
    
    Sheets("Sheet2").Range("A1").Delete Shift:=xlUp
            
End Sub

Edit Sheet1 and Sheet2 as necessary.

This will create a list, starting in A1 on sheet2 with each entry in column A in sheet2 which has a 1 next to it in column B.

 

[chrisl]

This might work

in E1 - enter the catgegory you want to appear in second list

The range starting from E3 could be on another sheet.

thread 240608.xls
	A	B	C	D	E
1				Entercategorytoappearinsecondlist	2
2
3	Animal	Category	Helper		Category2
4	Dog	1			Cat
5	Cat	2	1		Horse
6	Giraffe	1			Cow
7	Horse	2	2
8	Cow	2	3
9	Pig	1
10	Fish	3
11	Bird	1
12
13
Sheet1

 

[mikerickson]

If your data has headers, you can use AdvancedFilter to filter and copy.

Sub AdvancedFilterMove()
    Dim dataRange As Range
    Dim keyCol As Range, keyValue As Variant
    Dim destinationRange As Range
    Dim critRange As Range
    
    With ThisWorkbook.Sheets("Sheet1"): Rem adjust
        Set keyCol = Range("B:B"): Rem adjust
        keyValue = 1: Rem adjust
        Set dataRange = Range(.Cells(.Rows.Count, 1).End(xlUp), .Cells(1, 2))
    End With
    
    Set destinationRange = ThisWorkbook.Sheets("Sheet2").Range("a1")
          
    Rem set critrange
        With destinationRange.Parent.UsedRange
            Set critRange = .Parent.Cells(1, .Column + .Columns.Count + 1)
        End With
        If critRange.Column < destinationRange.Column + dataRange.Columns.Count Then
            Set critRange = critRange.Parent.Cells(1, destinationRange.Column + dataRange.Columns.Count)
        End If
        
        Rem write criteria
        Set critRange = critRange.Resize(2, 1)
        critRange.Range("A1").Value = keyCol.Range("a1").Value
        critRange.Range("A2").FormulaR1C1 = "'= " & CStr(keyValue)
    Rem filter + move
        destinationRange.Resize(, dataRange.Columns.Count).EntireColumn.ClearContents
            
        dataRange.AdvancedFilter Action:=xlFilterCopy, _
            CriteriaRange:=critRange, CopyToRange:=destinationRange, Unique:=False
    Rem clean-up
        critRange.EntireColumn.Delete
End Sub

 

[Lucianp]

Thank you, everyone, for your replies.

I now have a few options to work with and learn before I decide which one I will finally use.

I also read in one of the threads about Worksheet_Change so I may play with that too and see if I can automate it a bit.

This forum is a great learning tool. You get the answer to your specific problem without reading a gazillion books.

thanks again.

 

[xiaoju]

Thank you!!!
This old post just answered my problem of today!!