Macro that pastes adjacent columns

Question

I have this two tables in Excel:

I need to paste the "Text" and "Code" columns of the second table, right up to the "Currency" column of the first table, where the "optional name" column of the first table is equal to the "name" column of the second table.

In the end it should appear a table like this:

I was trying to create a macro with Excel vba that would automatically compare and then paste the corresponding values, but I haven't got much success :(

This could easily be done through formula's or even powerquery. No need for vba. Start exploring `VLOOKUP` as a start. — JvdV, Sep 01 '20 at 11:37

T.M. · Answer 1 · 2020-09-02T05:27:06.277

Alternative using array comparison via Match

Just to show an alternative to classical (range) loops which can be time consuming, I demonstrate an approach using two datafield arrays comparing identifying name columns in different sheets.

In this example Sheet1 names in column C get assigned to array a, whereas Sheet2 names to array b - see section 0-1
Both arrays get compared via Application.Match resulting in a (vertical) index array indicating where to search in the second data set - see section 2.
Eventually data get rearranged via Application.Index (see section 3) and are written to any wanted target (here to Sheet1's columns F:G, i.e. 3 columns after C; see section 4).

Example call

Option Explicit                                         ' declaration head of code module

Sub ExampleCall()
'0. get identifying name column ranges; here using the sheets' Code(Name)
    Dim rngA As Range: Set rngA = getColRange(Sheet1, "C")
    Dim rngB As Range: Set rngB = getColRange(Sheet2, "A")
'1. assign values to variant 1-based 2-dimensional arrays
    Dim a, b                                            ' declare as variant arrays
    a = rngA.Value
    b = rngB.Value
'2. get indices where to search in b
    a = Application.Match(a, b, 0)                      ' compare name columns
    'Debug.Print Join(Application.Transpose(a), "|")    ' write search order to immediate window
'3a.get text + code data
    b = rngB.Offset(0, 1).Resize(Columnsize:=2).Value   ' get text/code values starting next column
'3b.reorder b-array based on a-indices
    b = Application.Index(b, a, Array(1, 2))            ' reorder them based on a-indices
'4. write text + code to target ( col C + 3 cols offset ~> col F)
    rngA.Offset(0, 3).Resize(UBound(b), 2) = b
End Sub

Help function

Calculates the last row of a given sheet's column and returns the entire range.

Function getColRange(mySheet As Worksheet, _
                     Optional ByVal myColumn As Variant = "A", _
                     Optional ByVal Startrow As Long = 2) As Range
With mySheet
'a) check if sheet exists
    If IsError(Application.Evaluate(mySheet.Name & "!A1")) Then GoTo SHEETERROR
'b) change numeric column no to letter(s)
    If IsNumeric(myColumn) Then myColumn = Split((.Columns(myColumn).Address(, 0)), ":")(0)
'c) get last row in given column
    Dim lastRow As Long
    lastRow = .Range(myColumn & .Rows.Count).End(xlUp).Row
'd) return data range as function result
'   (a Range is an Object and has to be SET!)
    Set getColRange = .Range(myColumn & Startrow & ":" & myColumn & lastRow)
End With
Exit Function

SHEETERROR:
    MsgBox "Worksheet " & mySheet.Name & vbNewLine & _
           "(CodeName " & mySheet.CodeName & ")" & vbNewLine & _
           "does not exist!", vbExclamation, "Sheet Error"
    Stop
End Function

Related link

C.f. Some undocumented pecularities of the Application.Index function

score 0 · Accepted Answer · answered Sep 02 '20 at 08:52

In the end it turned out that was no need for VBA.

I've actually used the VLOOKUP function.

Here is where I've learned how to use this function:

https://support.microsoft.com/en-us/office/video-vlookup-when-and-how-to-use-it-9a86157a-5542-4148-a536-724823014785?ui=en-us&rs=en-us&ad=us

Macro that pastes adjacent columns

2 Answers2