0

I'm wondering if its possible to create a VBA that map a random "numerical codes" from an excel Spreadsheet 2 (let's say column A) to a column B (Spreadsheet 1).

Some of the values on the spreadsheet 2 are repeated, I would like to build a unique correspondence (no repeated values from column A / Spreadsheet 2 to my column B / Spreadsheet 1)

Spreadsheet1:

Spreadsheet1

Spreadsheet2

Spreadsheet2

Desired output, column filled from Spreadsheet2 (Unique)values :

Aim

Is this possible?? feasible??

Lorenzo Castagno
  • 528
  • 1
  • 10
  • 27
  • 1
    Yes, its very much so possible. Different ways, maybe your best bet is Dictionary since you seem to want to exclude zeros – JvdV Jan 20 '20 at 11:23
  • What determines which code goes to which condition? In the latest versions of Excel, you can do this with the worksheet `FILTER` function. – Ron Rosenfeld Jan 21 '20 at 01:31

1 Answers1

0

The following VBA code uses for loops to iterate through the list of values in Spreadsheet2 and only copy each value to Spreadsheet1 if the value has not occurred already in the list.

Option Explicit

Sub ListUniqueCodes()

    Dim code As Long
    Dim codes As Range
    Dim i As Integer
    Dim j As Integer
    Dim last_row As Integer
    Dim output_cell As Range
    Dim unique_codes As New Collection  'You could also use a Scripting.Dictionary here as suggested by JvdV
                                        'See https://stackoverflow.com/questions/18799590/avoid-duplicate-values-in-collection

    'Store the length of the list of codes that is in Spreadsheet2:
    last_row = Workbooks("Spreadsheet2.xlsx").Sheets("Sheet1").Range("A1").End(xlDown).Row

    'Store the list of codes that is in Spreadsheet2:
    Set codes = Workbooks("Spreadsheet2.xlsx").Sheets("Sheet1").Range("A1:A" & last_row)

    'For each code...
    For i = 1 To codes.Rows.Count
        code = codes.Cells(i).Value2

        '...if it does not equal zero...
        If code <> 0 Then

            '...and if it is not already in the collection unique_codes...
            For j = 1 To unique_codes.Count
                If unique_codes(j) = code Then Exit For
            Next j

            '...then add it to the collection unique_codes:
            If j = (unique_codes.Count + 1) Then
                unique_codes.Add code
            End If

        End If

    Next i

    Set output_cell = Workbooks("Spreadsheet1.xlsm").Sheets("Sheet1").Range("B2")

    'Write out the unique codes in Spreadsheet1:
    For i = 1 To unique_codes.Count
        output_cell.Offset(i - 1, 0).Value2 = unique_codes(i)
    Next i

End Sub
Everlearn
  • 63
  • 6
  • Hello! thanks for your time and help, the only error that I get when I run your VBA I got " Run time error ´9´: Subscript out of range" I can't find anything wrong. Again thanks for your time – Lorenzo Castagno Jan 21 '20 at 08:48
  • Hi Lorenzo, did you have both workbooks open in Excel when you ran the VBA macro? If one of the workbooks was closed then 'run time error 9' would result, so this might be the issue. – Everlearn Jan 21 '20 at 20:03