CODEWITHSUNDEEP
excelvbaexcel-formula
Fah
Fah

Reputation: 203

Get unique values from 2 columns and match these unique values in another sheet to populate the cell with the word OK

I need help to correct my code to check the unique values in 2 columns G and AI if is not empty or column G and AJ from a sheet named start and then look for these unique value match on column A in a sheet named Final. When It finds these value in column A It needs to populate the column C in the same row as the match number is located with the word OK.

Always will be 2 columns to be checked for a unique value. The values of Column 8 + the values of column 36 on the sheet Start need to be checked for unique values. However, if Columns 8 and 36 are empty then the code needs to check column 7 + column 35. enter image description here

I am using this code but seems incomplete.

 Sheets("Start").Activate
    Sintrlastrow1 = Sheets("Start").Cells(Cells.Rows.Count, "A").End(xlUp).Row
    SLastColumn = Sheets("Start").Cells.Find("*", [A1], , , xlByColumns, xlPrevious).Column
         Dim idsConsumerGalactic As Object
        Dim StartSheet As Range
        Dim Count As Integer
        Set StartSheet = Range(Cells(2, 1), Cells(Sintrlastrow1, SLastColumn))
        Set idsConsumerGalactic = CreateObject("Scripting.Dictionary")
        
      For Count = 2 To Sintrlastrow1
        If Sheets("Start").Cells(Count, 8).Value <> "" And Sheets("Start").Cells(Count, 36).Value <> "" Then '' --->>> columns that need to be checked for unique value 
            valor = Sheets("Interdiction").Cells(Count, 8).Value And Sheets("Start").Cells(Count, 36).Value  ''--->>> If columns H and AI is <> ""
        Else
            valor = Sheets("Start").Cells(Count, 7).Value And Sheets("Start").Cells(Count, 35).Value ''--->>> if columns H and AI is "" then needed to check conlumns G and AJ for unique values
        End If
        
            If idsConsumerGalactic.Exists(valor) Then
                idsConsumerGalactic(valor) = (idsConsumerGalactic(valor) + 1)
            Else
                idsConsumerGalactic.Add valor, 1
            End If
        Next Count
    
    Sheets("Final").Activate
        For Each consumer In idsConsumerGalactic  ''-->> Trying to loop the Final sheet to find the unique value match where is the row of the unique value and add OK on the column C  
            If (idsConsumerGalactic(consumer) = 1) Then
                Set Match = Sheets("Final").Cells.Find(What:=consumer, LookIn:=xlValues, _
            LookAt:=xlWhole, SearchOrder:=xlByRows)
            If Match Then
             Sheets("Final").Cells(consumer.Row, 3).Value = "OK"
            End If
           End If
             Next

How to check both 2 columns for unique values and then look for it in another sheet??

How to populate the cell on column C with the word OK when the code finds the unique value from columns G and AI from sheet Start on column A in the sheet Final ?

Result I need

in the image the consumer numbers 2,4 and 5 are unique from column G and AI.

Upvotes: 0

Views: 117

Answers (1)

Tim Williams
Tim Williams

Reputation: 166595

Here's my best guess:

Sub tester()

    Dim wsStart As Worksheet, lastRow As Long, wsFinal As Worksheet
    Dim dict As Object, rw As Range, v, v2, k, m
    
    Set wsStart = ActiveWorkbook.Sheets("Start") ' or ThisWorkbook.sheets("Start") ?
    Set wsFinal = ActiveWorkbook.Sheets("Final")
    Set dict = CreateObject("Scripting.Dictionary")

    lastRow = wsStart.Cells(Cells.Rows.Count, "A").End(xlUp).Row
    For Each rw In wsStart.Range("A2:AJ" & lastRow).Rows
        v = rw.Cells(8).Value
        v2 = rw.Cells(36).Value
        
        If Len(v) = 0 Or Len(v2) = 0 Then
            v = rw.Cells(7).Value
            v2 = rw.Cells(35).Value
        End If
        
        dict(v) = dict(v) + 1
        dict(v2) = dict(v2) + 1
    Next rw
    
    For Each k In dict
        If dict(k) = 1 Then
            m = Application.Match(k, wsFinal.Columns(1), 0)
            If Not IsError(m) Then wsFinal.Cells(m, 3).Value = "OK"
        End If
    Next k
 
End Sub

Upvotes: 1

Related Questions