Selecting and Pasting Cells

Question

I'm relatively new to VBA, I have only some experience with Python and only very little experience looking at other VBA macros and adjusting them to my need, so I'm trying to do what I can.

What I am trying to do is for each part number pasted in worksheet B (worksheet B, row A) I want to find the same part number from a different worksheet containing all part numbers (worksheet D, row A) and copy the description (worksheet D, row H) from worksheet D to another column, (worksheet B, row D) then check the next part number in the row and repeat.

The current error that I'm getting is that there is "Compile error: Else without if", I'm sorry that I am not very proficient, but any help would be greatly appreciated.

Other information:

-My part numbers to search through in worksheet B, column B are filled in from worksheet A, is it okay to just make it =A!B2 or =CONCATENATE(A!B2)?

Sub Description()

Dim wsA As Worksheet, wsB As Worksheet, wsC As Worksheet, wsD As Worksheet
Dim Rng As Range
Set wsB = Worksheets("B")
Set wsD = Worksheets("D")

Do: aRow = 2
        If wsB.Cells(aRow, 2) <> "" Then
     With Worksheets("D").Range("A:A")
        x = wsB.Cells(aRow, 2)
        Set Rng = .Find(What:=x, _
                        After:=.Cells(.Cells.Count), _
                        LookIn:=xlValues, _
                        LookAt:=xlWhole, _
                        SearchOrder:=xlByRows, _
                        SearchDirection:=xlNext, _
                        MatchCase:=False)

        Selection.Copy
        wsB.Cells(dRow, 2).Paste
     dRow = dRow + 1
    Else
        aRow = aRow + 1

Loop Until wsB.Cells(aRow, 2) = ""
End Sub

Thanks again!

Edit: Can't Execute code in break mode is current error

Sub Description()
Dim wsA As Worksheet, wsB As Worksheet, wsC As Worksheet, wsD As Worksheet
Dim Rng As Range
Set wsB = Worksheets("B")
Set wsD = Worksheets("D")
aRow = 2
dRow = 2

    Do:
        If wsB.Cells(aRow, 1) <> "" Then
            With Worksheets("D").Range("A:A")
                Set Rng = .Find(What:=wsB.Cells(aRow, 1), _
                                After:=.Cells(.Cells.Count), _
                                LookIn:=xlValues, _
                                LookAt:=xlWhole, _
                                SearchOrder:=xlByRows, _
                                SearchDirection:=xlNext, _
                                MatchCase:=False)
                Rng.Copy
                Rng.Offset(0, 3).Paste (Cells(aRow, 4))
                dRow = dRow + 1
                aRow = aRow + 1
            End With
        End If
    Loop Until wsB.Cells(aRow, 1) = ""
End Sub

Answer 1

Can you try to put End If on the next line after aRow = aRow + 1. See MSDN for syntax msdn.microsoft.com/en-us/library/752y8abs.aspx

Answer 2

In Excel we usually call vertical range as column, and horizontal one as row. From your code and question description, I assume what you said "row A" is column A. Also, your code scan through wsB.Cells(aRow, 2). It is column B not column A. Anyway, this is just a minor problem.

The following code will check cells of column B of worksheet B. If the same value is found in column A of worksheet D, then the cooresponding cell in column H of worksheet D will be copied to the cell in column B of worksheet B.

Option Explicit
Sub Description()
   Dim wsB As Worksheet, wsD As Worksheet, aRow As Long
   Dim rngSearchRange As Range, rngFound As Range
   Set wsB = Worksheets("B")
   Set wsD = Worksheets("D")
   Set rngSearchRange = wsD.Range("A:A")
   aRow = 2
   Do While wsB.Cells(aRow, 2).Value <> ""
      Set rngFound = rngSearchRange.Find(What:=wsB.Cells(aRow, 2).Value, LookAt:=xlWhole)
      If Not rngFound Is Nothing Then
         wsD.Cells(rngFound.Row, 8).Copy Destination:=wsB.Cells(aRow, 4)  ' Indexes of Column H, D are respectively 8, 4
      End If
      aRow = aRow + 1
   Loop
End Sub

Answer 3

Here's what worked for me.

Sub Description()
    Application.ScreenUpdating = False
    Dim LastRow As Long
    LastRow = Sheets("B").Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    Dim rng As Range
    Dim foundRng As Range
    For Each rng In Sheets("B").Range("B2:B" & LastRow)
        Set foundRng = Sheets("D").Range("A:A").Find(rng, LookIn:=xlValues, lookat:=xlWhole)
        If Not foundRng Is Nothing Then
            Sheets("B").Cells(rng.Row, "D") = Sheets("D").Cells(foundRng.Row, "H")
        End If
    Next rng
    Application.ScreenUpdating = True
End Sub