Is there a way to replace a cell value in a sheet based on another specific value in another sheet

Question

Good afternoon,

I tried to make the title as clear as possible and I realize that I probably failed, basically I have two sheets in a workbook, Sheet 1 is a sheet I use for Lookup Values (Data Validations with Drop-down lists are in Sheet 2), sorry if my terms are not good, i'm not an expert in Excel and speak mostly french. My drop-down list in Sheet 2 looks up the Value in Sheet 1 Column A (Which are numbers) and in Column B is the text value that matches the numbers in my system. What I want to do is set up the drop-down list to show me the text values in Column B and then run some kind of macro/formula to replace that value with the number value (Which is always the cell on the left of that value).

First question I ask here, been reading a bit so please let me know if anything is needed to further help me.

Thank you

Answer 1

A Match Transfer

Adjust the values in the constants section.

Option Explicit

Sub getValues()

    Const Proc As String = "getValues"
    On Error GoTo resolveError

    With Application
        .ScreenUpdating = False
        .Calculation = xlCalculationManual
        .EnableEvents = False
    End With

    Const srcName As String = "Sheet1" ' Source Worksheet Name
    Const srcFirst As Long = 2    ' Source First Row Number
    Const srcValue As Long = 1    ' Source Value Column Number
    Const srcLookUp As Long = 2   ' Source Lookup Column Number
    Const tgtName As String = "Sheet2" ' Target Worksheet Name
    Const tgtFirst As Long = 2    ' Target First Row Number
    Const tgtLookUp As Long = 2   ' Target Lookup Column Number

    Dim rng As Range
    Dim Source(1) As Variant      ' Source 3D Array (Lookup and Value Arrays)
    Dim Target As Variant         ' Target (Column) Array (LookUp Array)
    Dim CurInd As Long            ' Current Index of Source Arrays
    Dim i As Long                 ' Target Array Row Counter
    Dim Transferred As Boolean    ' Success Checker

    ' Write columns to arrays.
    With ThisWorkbook.Worksheets(srcName)
        Set rng = .Columns(srcLookUp).Find("*", , xlFormulas, , , xlPrevious)
        If rng Is Nothing Then Exit Sub
        If rng.Row < srcFirst Then Exit Sub
        Set rng = .Range(.Cells(srcFirst, srcLookUp), rng)
        Source(0) = rng.Value
        Source(1) = rng.Offset(, srcValue - srcLookUp).Value
    End With
    With ThisWorkbook.Worksheets(tgtName)
        Set rng = .Columns(tgtLookUp).Find("*", , xlFormulas, , , xlPrevious)
        If rng Is Nothing Then Exit Sub
        If rng.Row < tgtFirst Then Exit Sub
        Set rng = .Range(.Cells(tgtFirst, tgtLookUp), rng)
        Target = rng.Value
    End With

    ' Lookup the values of Target Array (Target) in Source Lookup Array
    ' (Source(0)) and replace Current Value of Target Array with values found
    ' in the same row of Source Value Array (Source(1)).
    For i = 1 To UBound(Target)
        On Error Resume Next
        CurInd = WorksheetFunction.Match(Target(i, 1), Source(0), 0)
        If Err.Number = 0 Then
            ' found a match
            Target(i, 1) = Source(1)(CurInd, 1)
        Else
            ' if no match found
        End If
        On Error GoTo 0
    Next i
    On Error GoTo resolveError

    ' Write modified Target Array to Target Range.
    rng.Value = Target

    Transferred = True

CleanExit:
    With Application
        .EnableEvents = True
        .Calculation = xlCalculationAutomatic
        .ScreenUpdating = True
    End With

    ' Inform user.
    If Transferred Then
        MsgBox "'" & Proc & "' has successfully transferred the data.", _
          vbInformation, "Transfer Success"
    End If

    Exit Sub

resolveError:
    MsgBox "An unexpected error occurred in '" & Proc & "'." & vbCr _
         & "Run-time error '" & Err.Number & "':" & vbCr & Err.Description _
           , vbCritical, Proc & " Error"
    On Error GoTo 0
    Resume CleanExit

End Sub