CODEWITHSUNDEEP
vbaexcelreplace
El_1988
El_1988

Reputation: 339

VBA, Merge Tables in sheets based on identifier column in specified sheet

I am new to VBA. I have two sheets containing two Tables sheet 1 is a glossary of abbreviations in a column under header "Material" and the descriptions in a column under header "Material Description". Sheet 2 is a data set containing a column under header "Customer Names", a column under header "Material", and a column under header "Invoiced Values".

Example:

Sheet 1      
Material    Material Description
   X               Hot
   B               Cold
   C               Temp
-------------------------------------
Sheet 2       
Material       Invoice Value
   X               2.7645  
   X               3.9
   B               4.6

Desired output:

Sheet 3
Material        Invoice Value
   Hot               2.7645  
   Hot               3.9
  Cold               4.6

I am trying to:

  1. Find columns with specified headers in respective sheets
  2. For each row column "Material" of sheet 1, find the "Material" in sheet 2 that corresponds to same "Material" in sheet 1
  3. Replace the text in the row of column "Material" in sheet 2, with the corresponding value of "Material Description" in sheet 1

For item 1 I have gotten as far as :

Sub Replace()

    Dim startrow As Long
    Dim custrng As Range
    Dim matdatrng As Range
    Dim valrng As Range
    Dim dscrng As Range
    Dim matname As Range

    startrow = 2

    Set rcustrng = Worksheets("Data").UsedRange.Find("Customer Name", , xlValues, xlWhole)
    Set matdatrng = Worksheets("Data").UsedRange.Find("Material", xlValues, xlWhole)
    Set valrng = Worksheets("Data").UsedRange.Find("Invoiced Value", xlValues, xlWhole)
    Set matname = Worksheets("Names").UsedRange.Find("Material", xlValues, xlWhole)
    Set dscrng = Worksheets("Names").UsedRange.Find("Material Description", xlValues, xlWhole)

End Sub

Any and all help/suggestions is appreciated, I am hoping to expand this to three data sets.

Upvotes: 0

Views: 519

Answers (1)

El_1988
El_1988

Reputation: 339

I was able to do by using the code in the following link contributed by Mumps:

https://www.ozgrid.com/forum/forum/help-forums/excel-general/138286-vba-to-join-tables-with-unique-key-in-first-column

Sub CopyRange()
Application.ScreenUpdating = False
Dim LastRow As Long
LastRow = Sheets("OCData").Cells.Find("*", SearchOrder:=xlByRows,      SearchDirection:=xlPrevious).Row
Dim ID As Range
Dim foundID As Range
For Each ID In Sheets("OCData").Range("C2:C" & LastRow)
    Set foundID = Sheets("NamesList").Range("B:B").Find(ID, LookIn:=xlValues, lookat:=xlWhole)
    If Not foundID Is Nothing Then
        Sheets("NamesList").Range("B" & foundID.Row & ":E" & foundID.Row).Copy Sheets("OCData").Range("J" & ID.Row)
    End If
Next ID
Application.ScreenUpdating = True
End Sub

Awesome code, saved me loads of time.

Upvotes: 0

Related Questions