Home > Back-end >  Copy the values of from once cell to another matching cell using VBA
Copy the values of from once cell to another matching cell using VBA

Time:11-03

I am trying to copy values from once column to another using vba. I am using the follwoing vba script:

Private Sub Import_Click()

  Worksheets("test").Range("D10:D49") = Worksheets("test2").Range("G22:G61").Value
End Sub

But this just copies the values from one column to another. My question is this, consider the example below:

enter image description here

I want to copy the "Num" from table 1 to table 2 by matching it with the "items". Is there a way to do it using VBA? cuz, my actual list is really long.

CodePudding user response:

If you are dealing with a large number of data and want to use VBA you can use dynamic arrays.

Try this example :

I have reproduced your example assuming first table is located on columns A & B, and 2nd one E & F (boths on first line):

Sub lookup_with_arrays()
Dim wb As Workbook
Dim ws As Worksheet
Dim arr1(), arr2() As Variant
Dim lastrow_arr1, lastrow_arr2, i, j As Long
Set wb = Workbooks("Your_File.xlsm")
Set ws = wb.Worksheets("Your_Sheet")

lastrow_arr1 = Range(ws.Cells(1, 1), ws.Cells(1, 1).End(xlDown)).Rows.Count
lastrow_arr2 = Range(ws.Cells(1, 5), ws.Cells(1, 5).End(xlDown)).Rows.Count

'Set dynamic dimensions
ReDim arr1(1 To lastrow_arr1, 1 To 2)
ReDim arr2(1 To lastrow_arr2, 1 To 2)

'Indicate which data to set up in the arrays
For i = LBound(arr1) To UBound(arr1)
    arr1(i, 1) = ws.Cells(i, 1)
    arr1(i, 2) = ws.Cells(i, 2)
Next i
For i = LBound(arr2) To UBound(arr2)
    arr2(i, 1) = ws.Cells(i, 5)
    arr2(i, 2) = ws.Cells(i, 6)
Next i

'Now we can match both Items colums and complete arr2 second column
For i = LBound(arr1) To UBound(arr1)
    For j = LBound(arr2) To UBound(arr2)
        If arr1(i, 1) = arr2(j, 1) Then
        arr2(j, 2) = arr1(i, 2)
        Exit For
        End If
    Next j
Next i

'Then you can report arr2 in your worksheet
For i = 2 To UBound(arr2)
    ws.Cells(i, 6) = arr2(i, 2)
Next i
End Sub

Another option would be to use a Vlookup function :

Function VLOOKUP(TheValueYouNeed As Variant, RangeOfSearch As Range, No_index_col As Single, Optional CloseValue As Boolean)
On Error GoTo VLookUpError
    VLOOKUP = Application.VLOOKUP(TheValueYouNeed, RangeOfSearch, No_index_col, CloseValue)
    If IsError(VLOOKUP) Then VLOOKUP = 0
Exit Function
VLookUpError:
    VLOOKUP = 0
End Function

I am not the creator of the function but I don't remember where I have found it (thanks anyway)

And then use it nearly as if you were in excel :

Sub lookup_using_function()
Dim lastrow_arr1, lastrow_arr2, i As Long
Dim looked_item As Variant
Dim search_table  As Range
Dim col_num As Single
Dim bool As Boolean

Dim wb As Workbook
Dim ws As Worksheet
Set wb = Workbooks("Your_File.xlsm")
Set ws = wb.Worksheets("Your_Sheet")
lastrow_arr1 = Range(ws.Cells(1, 1), ws.Cells(1, 1).End(xlDown)).Rows.Count
lastrow_arr2 = Range(ws.Cells(1, 5), ws.Cells(1, 5).End(xlDown)).Rows.Count

Set search_table = ws.Range("A:B")
col_num = 2
bool = False

For i = 2 To lastrow_arr2
    looked_item = ws.Cells(i, 5)
    ws.Cells(i, 6) = VLOOKUP(looked_item, search_table, col_num, bool)
Next i

Then I usually insert a form, right click on it to assign a macro. On click the macro assigned is executed.

Edit following your comment:

Cells() works with coordinates.

For example ws.Cells(5,4) stands for cell 5th row of 4th column in the worksheet called ws.

So If your table starts on line 6 and column 3:

'Indicate which data to set up in the arrays (i 5 instead of i)
For i = LBound(arr1) To UBound(arr1)
    arr1(i, 1) = ws.Cells(i 5, 3)
    arr1(i, 2) = ws.Cells(i 5, 4)
Next i

LBound and Ubound are useful in order to set for loop for an entire array.

To loop through lines :

For i=LBound(arr1) to UBound(arr1)
Next i

To loop through columns you provide the additional argument 2 (default is 1)

For i=LBound(arr1, 2) to UBound(arr1, 2)
Next i

If your table have various columns you may have to loop also through columns to specify which data you want:

For i=LBound(arr1) to UBound(arr1)
    For j=LBound(arr1, 2) to UBound(arr1, 2)
    arr1(i, j) = ws.Cells(i 5, j 2)
    Next j
Next i

  • Related