VBA - Extracting unique data based on multiple criteria

**donjamin** · 04-18-2019, 04:16 AM

Hello All,

Hoping someone can kindly assist with this query.

At present, I am using the following code for extracting unique data (but without any conditions):

Sub CopyUnique()
    Dim s1 As Worksheet, s2 As Worksheet
    Set s1 = Sheets("Sheet2")
    Set s2 = Sheets("Sheet1")
    s1.Range("AB2:AB7000").Copy s2.Range("A3")
    s2.Range("C:C").RemoveDuplicates Columns:=1, Header:=xlNo
End Sub

What I'd also like to be able to do, is still extract the above but only when the values in Sheet1 Column A = Sheet2 $A$1 and Sheet 1 Column K = Sheet 2 $B$1.

Hoping this is possible and that I've appropriately conveyed what I need.

Thanks ever so much for the support.

**sintek** · 04-18-2019, 04:38 AM

Hi donjamin

Play around with this...assuming sheet1 has headers in row 1

Option Explicit

Sub Extract()
Dim Val1 As String, Val2 As String
Application.ScreenUpdating = False
Val1 = Sheet2.Range("A1"): Val2 = Sheet2.Range("B1")
With Sheet1
    With .Cells(1).CurrentRegion
        .AutoFilter 1, Val1
        .AutoFilter 11, Val2
        .Offset(1, 0).SpecialCells(12).Copy Sheet2.Range("A3")
    End With
    .AutoFilterMode = False
End With
Application.ScreenUpdating = True
End Sub

**donjamin** · 04-18-2019, 04:52 AM

Thanks sintek, much appreciate your support, however (and apologies) this isn't working and may be due to my lack of clarity.

Where I noted it needed to match values in Sheet 1 Column A, it actually needs to match text, with Sheet 1 Column K being the value.

Hope that helps.

**sintek** · 04-18-2019, 05:02 AM

Please upload a sample file...

**donjamin** · 04-18-2019, 05:39 AM

I'm struggling to figure out how to attach something as when I go to do it I'm just seeing a blank white box.

Any ideas?

I have managed to get this VBA to work, though without the desired result.

My originally posted VBA would look at the entire workbook Column A - FJ and provide the unique values from column AC in the next sheet. I need the new one to just do that but with the conditions. The result of the VBA you've kindly provided is filtering as desired but only returning columns 1-12 when I just require column 29.

**jindon** · 04-18-2019, 05:46 AM

Attach a sample workbook (not a picture or pasted copy). Make sure there is just enough data to demonstrate your need. Include a BEFORE sheet and an AFTER sheet in the workbook if needed to show the process you're trying to complete or automate. Make sure your desired results are shown, mock them up manually if necessary.

Remember to desensitize the data.

Click on GO ADVANCED and then scroll down to Manage Attachments to open the upload window.

**sintek** · 04-18-2019, 06:10 AM

Option Explicit

Sub Extract()
Dim Val1 As String, Val2 As String, lr As Long
Application.ScreenUpdating = False
Val1 = Sheet2.Range("A1"): Val2 = Sheet2.Range("B1")
With Sheet1
    With .Cells(1).CurrentRegion
        .AutoFilter 1, Val1
        .AutoFilter 11, Val2
    End With
    lr = .Range("AB" & Rows.Count).End(xlUp).Row
    .Range("AB2:AB" & lr).SpecialCells(12).Copy Sheet2.Range("A3")
    .AutoFilterMode = False
End With
Application.ScreenUpdating = True
End Sub

**donjamin** · 04-18-2019, 06:17 AM

Sintek, you're a legend!

Are you able to remove duplicates from within that code?

**sintek** · 04-18-2019, 06:30 AM

Give this version a go...tx jindon

Sub Extract2()
Dim Valu, Temp(), i As Long, cnt As Long
With Sheet1.Cells(1).CurrentRegion.Resize(, 28)
    Valu = .Value: cnt = 0
    For i = 1 To UBound(Valu, 1)
        If Valu(i, 1) = Sheet2.Range("A1") And Valu(i, 11) = Sheet2.Range("B1") Then
            ReDim Preserve Temp(cnt)
            If Not IsNumeric(Application.Match(Valu(i, 28), Temp, 0)) Then
                Temp(cnt) = Valu(i, 28)
                cnt = cnt + 1
            End If
        End If
    Next i
End With
Sheet2.Range("A3").Resize(cnt) = Application.WorksheetFunction.Transpose(Temp)
End Sub

EDit...Forgot...

Are you able to remove duplicates from within that code?

Sheet2.Columns("A:A").RemoveDuplicates 1

**donjamin** · 04-18-2019, 06:46 AM

Works brilliantly, thank you very much sintek!

**sintek** · 04-18-2019, 06:50 AM

............................................
Thanks.gif
Please mark thread as solved...

VBA - Extracting unique data based on multiple criteria

LinkBack

Thread Tools

Rate This Thread

Display

Hybrid View

VBA - Extracting unique data based on multiple criteria

Re: VBA - Extracting unique data based on multiple criteria

Re: VBA - Extracting unique data based on multiple criteria

Re: VBA - Extracting unique data based on multiple criteria

Re: VBA - Extracting unique data based on multiple criteria

Re: VBA - Extracting unique data based on multiple criteria

Re: VBA - Extracting unique data based on multiple criteria

Re: VBA - Extracting unique data based on multiple criteria

Re: VBA - Extracting unique data based on multiple criteria

Re: VBA - Extracting unique data based on multiple criteria

Re: VBA - Extracting unique data based on multiple criteria

Thread Information

Users Browsing this Thread

Similar Threads

Distinct function/ Formula or Unique Data based on multiple criteria

Extracting rows of data based on multiple criteria from a list

[SOLVED] Extracting unique data based on criteria

Extract Unique data based on multiple criteria

Adding a date range to a unique data count based on multiple criteria

Extracting Unique Records and Copying into Another Sheet Based on Various Criteria

Extracting rows based on multiple ranges and unique numbers

Bookmarks

Bookmarks

Posting Permissions