VLOOKUP or similar to cut/paste data

[Extivalis]

Hi All,

I'm looking for a way to write a macro into VBA that will compare values in Column C to Column I, and when there's a match, cut the value in Column D and paste it into Column G. So, for example, if C22 matches I9, cut D22 and paste to G9.

By the time this macro is run, any duplicates within the same column would have been removed, (no two identical values within the same column), so there's now concern about multiple matches. Also, there's no limit to the number of rows that would need to be checked (this is going into a template, and the number of rows used will vary)

I'm only vaguely familiar with VLOOKUP, which is why I mention it, but it doesn't need to be the function used if there's a better way to go about this.

Thanks.

 

[myall_blues]

Hi

Try this code. My test data and output result in column G shown in image.

Regards

Murray

Option Explicit
Sub Extivalis()
    Const startRowI As Long = 2  ' <-- Change to match starting row of data in column I
    Const startRowC As Long = 5  ' <-- Change to match starting row of data in column I
    Const inSheet As String = "Sheet1"  ' <-- Change to match name of worksheet
    Dim lastRowI As Long, lastRowC As Long, i As Long, j As Long
    '
    lastRowI = Sheets(inSheet).Range("I" & startRowI).End(xlDown).Row
    lastRowC = Sheets(inSheet).Range("C" & startRowC).End(xlDown).Row
    '
    For i = startRowI To lastRowI
        For j = startRowC To lastRowC
            If Cells(i, 9).Value = Cells(j, 3).Value Then
                Cells(i, 7).Value = Cells(j, 4).Value
            End If
        Next j
    Next i
End Sub

 

[LazyBug]

Hello, @Extivalis!
Try this on a copy of your data:

Sub ttt()
Dim a, i&, ii
With ActiveSheet
    a = Range("C2:D" & Range("C" & Rows.Count).End(xlUp).Row).Value 'amend C2 to your first cell with data address in C column
    For i = 1 To UBound(a)
        Set ii = Range("I2:I" & Range("I" & Rows.Count).End(xlUp).Row).Find(a(i, 1), , xlValues, xlWhole)  'amend I2 to your first cell with data address in I column
            If ii Is Nothing Then
                MsgBox "no " & a(i, 1) & " found at I column"
'                Exit Sub
            Else
                ii(1, -1).Value = a(i, 2)
'                Cells(i + 1, 4).ClearContents 'uncomment if you want to delete values from D column after moving it to I
            End If
    Next i
End With
End Sub

 

[kvsrinivasamurthy]

Try Code.

Sub PasteToG()
Dim Stro&, Lr&, T&
Dim M
Stro = 3    'change start row number as per your data
Lr = Range("C" & Rows.Count).End(xlUp).Row
M = Evaluate("transpose(Iferror(match(C" & Stro & ":C" & Lr & ",I" & Stro & ":I" & Lr & ",0),""""))")
For T = 1 To UBound(M)
If M(T) <> "" Then
Range("D" & Stro + T - 1).Cut Range("G" & Stro + M(T) - 1)
End If
Next T
End Sub