Compare and copy matching data from adjacent cells

Question

I was having some trouble with a macro I have been writing. I am trying to find a match in column A and column D. When I detect a match I want to copy the adjacent cells of each IE copy the contents of B of the line of the first match to E where the match occurs in D. Whenever I do this I never get the right copy. It will copy the values that match but put them in the completely wrong space. I only encounter a problem when the order is mixed up or there is a white space. Any suggestions would be helpful.

Thanks

Nick.

Note: In this version of my code I was using input boxes to pick what two columns of data the user wants to compare and the one he wants to copy from and paste too. It should not make a big difference.

Sub Copy()
Dim column1 As String
Dim column2 As String
Dim from As String
Dim too As String

numrows = Sheet1.Range("A1").Offset(Sheet1.Rows.Count - 1, 0).End(xlUp).Row

'MsgBox numrows

column1 = InputBox("which column do you want to select from")
column2 = InputBox("which column do you want to compare to ")
from = InputBox("which column do you want to copy data from")
too = InputBox("which column do you want to copy data to")

Dim lngLastRow As Long
Dim lngLoopCtr As Long
Dim i As Long
Dim j As Long
Dim value As String

lngLastRow = Range(column1 & Rows.Count).End(xlUp).Row
lngLastRow2 = Range(column2 & Rows.Count).End(xlUp).Row
'lngLastRow = Sheet1.Range("A1").Offset(Sheet1.Rows.Count - 1, 0).End(xlUp).Row
Dim temp As String

For i = 1 To lngLastRow Step 1
    temp = Cells(i, column1).value
    value = Cells(i, from).value
    'MsgBox "temp"
    'MsgBox (temp) 

    If Cells(i, column1).value <> "" Then
        For j = 1 To lngLastRow2 Step 1    
            ' MsgBox "cell"
            ' MsgBox (Cells(j, column2).value)

            If Cells(j, column2).value = "" Then
                Cells(j, column2).Offset(1, 0).Select
            End If

            If Cells(j, column2).value <> "" Then
                If temp = Cells(j, column2).value Then
                'MsgBox "equal"
                'MsgBox "i"
                'MsgBox i
                'MsgBox "j"
                'MsgBox j
                'value = Cells(j, from).value
                'MsgBox Cells(i, too).value
                'Cells(i, too).value = Cells(j, from).value 
                'Dim num As Integer
                'On Error Resume Next
                'num = Application.WorksheetFunction.VLookup(temp, Sheet1.Range("A0:M13"), 3, False)

                     Cells(i, too).value = Cells(j, from).value
                'MsgBox j
                ' MsgBox (Cells(i, column1).value)
                ' MsgBox "="
                ' MsgBox (Cells(j, column2).value)
                End If
            End If
        Next j
    End If
Next i
End Sub

Answer 1

I have studied your text and your macro and think the macro below does what you want.

If this macro does what you want, your problem was caused by your use of meaningless variable names such as: column1 , column2 , i and j . This meant you did not notice you were using the wrong variables in the statement that copied values.

I have renamed all your variables. I am not asking you to like my naming convention but I am recommending you have a naming convention. I can look at macros I wrote years ago and know what all the variables are because I developed my convention in my early days of VBA programming and have used it every since. This makes my life much easier when I need to update old macros.

I have added Option Explicit at the top of the module. Without this statement, a misspelt variable name becomes a declaration:

Dim Count As Long

Lots of statements

Count = Conut + 1

This causes Conut to be declared with a value of zero. Such errors can be a nightmare to find.

I have used a With Statement to make explicit which worksheet I am using.

You checked both cells to not be empty. I only check the first because it is not necessary to check the second since, if the second is empty, it will not match the first.

Your code did not stop working down the Compare column if it found a match so my code does the same. This is correct if values can repeat in the Compare column. If they cannot repeat, you may wish to add Exit For to exit the inner loop after a match has been processed.

I believe the above explains all the changes I hve made.

Option Explicit
Sub Copy()

  Dim ColCompare As String
  Dim ColCopyFrom As String
  Dim ColCopyTo As String
  Dim ColSelect As String
  Dim RowCrntCompare As Long
  Dim RowCrntSelect As Long
  Dim RowLastColCompare As Long
  Dim RowLastColSelect As Long
  Dim SelectValue As String

  With Sheet1

    ColSelect = InputBox("which column do you want to select ColCopyFrom")
    ColCompare = InputBox("which column do you want to compare to ")
    ColCopyFrom = InputBox("which column do you want to copy data ColCopyFrom")
    ColCopyTo = InputBox("which column do you want to copy data to")

    RowLastColSelect = .Range(ColSelect & .Rows.Count).End(xlUp).Row
    RowLastColCompare = .Range(ColCompare & .Rows.Count).End(xlUp).Row

    For RowCrntSelect = 1 To RowLastColSelect Step 1
      SelectValue = .Cells(RowCrntSelect, ColSelect).value
      If SelectValue <> "" Then
        For RowCrntCompare = 1 To RowLastColCompare Step 1
          If SelectValue = Cells(RowCrntCompare, ColCompare).value Then
            .Cells(RowCrntCompare, ColCopyTo).value = _
                                           .Cells(RowCrntSelect, ColCopyFrom).value
          End If
        Next RowCrntCompare
      End If
    Next RowCrntSelect

  End With

End Sub