Copy Unique Values if Condition Met

[andybason]

Hello

I have a macro that copies unique values from one sheet to another.

It works ok but I need to add a condition so that it only copies the values if another cell on the same row as each value contains the word "Absent".

Is this possible? Any help would be appreciated.

Thank you

Sub CopyIDs()

Dim lastrow As Long

lastrow = ThisWorkbook.Sheets("StudentIDs").Cells(Rows.Count, "A").End(xlUp).Row

    ThisWorkbook.Sheets("StudentIDs").Range("A2:A" & lastrow).AdvancedFilter _
    Action:=xlFilterCopy, _
    CopyToRange:=ThisWorkbook.Sheets("Summary").Range("A55"), _
    Unique:=True

End Sub

 

[DanteAmor]

It would help if you put an example of how your data is in each of your sheets.

But try adapting the following. Assuming that your headers are in row 1, that your data starts in row 2, that the "other cell" is in column "C", that the column "C" header is "Condition". Create two data in your sheet "StudentIDs" in two cells that you have available, in my example I am using cells Z1 and Z2, the header Z1 must be equal to the header C1 (following my assumption).

Try:

Sub CopyIDs()
  Dim shS As Worksheet
  Dim lastrow As Long

  Set shS = ThisWorkbook.Sheets("StudentIDs")
  lastrow = shS.Cells(Rows.Count, "A").End(xlUp).Row
  shS.Range("A1:C" & lastrow).AdvancedFilter _
    Action:=xlFilterCopy, _
    CriteriaRange:=shS.Range("Z1:Z2"), _
    CopyToRange:=ThisWorkbook.Sheets("Summary").Range("A55"), _
    Unique:=True
End Sub

 

[andybason]

Thanks Dante, this is great.