VBA find and replace based on first column

[nihilik]

Hello

TD;DR: Find value in column A and if found replace value in another column

I have a list with sale ID and salesman ID on one sheet and a sheet with "fixes" for sales which were reported to have wrong salesman ID (this sheet also has sale ID and salesman ID). I need to replace salesman ID for sales in the report if the corresponding ID is in the fixes sheet, using VBA.

I already have VBA code using FIND but its incredibly slow when fixing thousands of rows. Anyone have a better idea? Thanks!

x = 2
Do While Len(ThisWorkbook.Sheets("fixes").Cells(x, 1)) > 0

sale_id = ThisWorkbook.Sheets("fixes").Cells(x, 1)
fixed_value = ThisWorkbook.Sheets("fixes").Cells(x, 5)

Set rng1 = ThisWorkbook.Sheets("sales").Range("A:A").Find(sale_id, , xlValues, xlWhole)
If Not rng1 Is Nothing Then
  rng1.Offset(0, 8) = fixed_value
End If

x = x + 1
Loop

 

[nihilik]

Nobody has any idea? I really am lost here.

 

[Fluff]

You could try this, but you'll need to add a reference.
In the VB editor
Tools > References > Microsoft Scripting Runtime making sure that the checkbox is ticked.

Sub nihilik()

    Dim Dict As Scripting.Dictionary
    Dim S_Id As Variant
    Dim SaleId As Variant
    Dim FixValu As Variant
    Dim Rw As Long
    Dim Cl As Range

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

    Rw = 1
    With ThisWorkbook.Sheets("fixes")
        S_Id = .Range("A2", .Range("A" & .Rows.Count).End(xlUp))
    End With

    Set Dict = CreateObject("scripting.dictionary")
    With Dict
        .CompareMode = TextCompare
        For Each SaleId In S_Id
            Rw = Rw + 1
            If Not IsEmpty(SaleId) Then
                If Not .Exists(SaleId) Then .Add (SaleId), ThisWorkbook.Sheets("fixes").Range("E" & Rw).Value
            End If
        Next
    End With

    With ThisWorkbook.Sheets("sales")
        For Each Cl In .Range("A1", .Range("A" & .Rows.Count).End(xlUp))
            If Dict.Exists(Cl.Value) Then Cl.Cells(1, 8) = Dict.Item(Cl.Value)
        Next Cl
    End With

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

End Sub

 

[nihilik]

Thanks, i also found a solution using two loops and MATCH function that is quite quick in case somebody has the same problem in the future. First loop finds the row number of the sale I am trying to fix and the second one fixes it.

Sub sales_fix()

Dim x As Long
Dim y As Long

x = 2
Do While Len(ThisWorkbook.Sheets("fixes").Cells(x, 1)) > 0

Sheets("fixes").Cells(x, 6) = Application.Match(Sheets("fixes").Cells(x, 1).Value, Worksheets("sales").Columns(1), 0)

x = x + 1
Loop

x = 2
Do While Len(ThisWorkbook.Sheets("fixes").Cells(x, 1)) > 0
On Error Resume Next

y = Sheets("fixes").Cells(x, 6).Value

If Len(Sheets("fixes").Cells(x, 2)) > 0 Then Sheets("sales").Cells(y, 2) = Sheets("fixes").Cells(x, 2)

x = x + 1
Loop

End Sub