Populate Column based on matching table

[log0r]

Hi all,

I need some help. I have 2 workbooks, one (results.xlsm) with SKUs in Column A, and I would like keywords I have for them put into Column B.

The 2nd workbook (keywords.xls) has some SKUs in Column A, and corresponding keywords in Column B.

I would like to use some VBA to match SKUs and where matched place Column B contents over. I have experience (thanks to here) with range.replace, and this is my example which would work (except it overwrites the SKU in Col.A, as opposed to putting the matched data beside it). Oh and also this code is using M:N for the SKU/keywords lookup - I've not had to make it look at another workbook yet)

Sub keywords()
Dim R As Range, Tbl As Range, c As Range
Set R = Range("A2:A" & Cells(Rows.Count, "A").End(xlUp).Row)
Set Tbl = Range("M:N")
Application.ScreenUpdating = False
For Each c In Tbl.Columns(1).Cells
    R.Replace c.Value, c.Offset(0, 1).Value, xlPart
Next c
Application.ScreenUpdating = True
End Sub

Any advice on what I should best be using would be much appreciated!

 

[MrKowz]

What is the name of the worksheet with the SKUs in results.xlsm and what is the name of the worksheet with the sku/keyword information in keywords.xls?

 

[MrKowz]

See if this gets you in the right direction. Replace the highlighted sheet names with your actual sheet names.

Public Sub PopulateKeywords()
Dim dict        As Object, _
    k           As Variant
    
Dim rng         As Range

Dim keyWB       As Workbook, _
    resultWB    As Workbook
    
Dim keyWS       As Worksheet, _
    resultWS    As Worksheet
    
Dim keyLR       As Long, _
    resultLR    As Long
    
With Application
    .ScreenUpdating = False
    .Calculation = xlCalculationManual
End With

Set keyWB = Workbooks("keywords.xls")
Set resultWB = Workbooks("results.xlsx")

Set keyWS = keyWB.Sheets("[B][COLOR="#FF0000"]Sheet1[/COLOR][/B]")
Set resultWS = resultWB.Sheets("[B][COLOR="#FF0000"]Sheet1[/COLOR][/B]")

Set dict = CreateObject("Scripting.Dictionary")

keyLR = keyWS.Range("A" & Rows.Count).End(xlUp).Row
resultLR = resultWS.Range("A" & Rows.Count).End(xlUp).Row

For Each rng In keyWS.Range("A2:A" & keyLR)
    If Not dict.Exists(rng.Value) Then
        'Append to dictionary object
        dict.Add rng.Value, rng.Offset(0, 1).Value
    End If
Next rng

Set rng = Nothing

For Each rng In resultWS.Range("A2:A" & resultLR)
    If dict.Exists(rng.Value) Then
        'Overwrite column B with definition
        rng.Offset(0, 1).Value = dict(rng.Value)
    End If
Next rng

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

End Sub

 

[log0r]

Hi MrKowz,

Thanks for the quick response, and code ~ I actually don't understand dict. at all but will begin to learn. However one immediate problem I have is a 1004 error when I get to the second line of the below:

Set dict = CreateObject("Scripting.Dictionary")


keyLR = keyWS.Range("A" & Rows.Count).End(xlUp).Row

Method 'Range' of object '_worksheet' failed

And I don't understand

 

[MrKowz]

Hi MrKowz,

Thanks for the quick response, and code ~ I actually don't understand dict. at all but will begin to learn. However one immediate problem I have is a 1004 error when I get to the second line of the below:

Set dict = CreateObject("Scripting.Dictionary")


keyLR = keyWS.Range("A" & Rows.Count).End(xlUp).Row

Method 'Range' of object '_worksheet' failed

And I don't understand

Did you replace the highlighted-red worksheet names with your actual worksheet names? If not, that would error.

As for the dictionary object, I recommend this article Excel VBA Dictionary - A Complete Guide - Excel Macro Mastery

 

[log0r]

Yep, They are Sheet1 in both cases... I did edit your setting of workbooks, as one you put xlsx, but mine is an xlsm (because this carries the macro, does a number of things and sales an xls as finished results - but I'm not running any part of that macro while testing this).