Compare and copy matching data from adjacent cells - vba

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 I.E 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