Nested "Do Until" and "For" loop in VBA - excel

Question

I am trying to create a macro that takes the data in column B from Sheet1 to Sheet2 if the names in column A Sheet1 corresponds to the names in column A in Sheet2. The first part of the code works fine, but the second part which is the "Do Until" loop is the problem. With the code I currently have, the loop runs through the outer loop and inner loop for the first name in Column A, but then it does not go through the outer loop for the rest of the names in Column A. The code is below:
Sub PullNames()
Dim A As Range
Dim B As Range
Dim C As Range
Dim A2 As Range
Dim B2 As Range
Dim C2 As Range
Dim LastA As Long
Dim LastB As Long
Dim LastC As Long
Dim LastA2 As Long
Dim CheckName As String
Dim CheckName2 As String
Dim count As Long
LastA = Sheets("Sheet1").Cells(Rows.count, 1).End(xlUp).Row
LastB = Sheets("Sheet1").Cells(Rows.count, 2).End(xlUp).Row
LastC = Sheets("Sheet1").Cells(Rows.count, 3).End(xlUp).Row
count = 2
Set A = Sheets("Sheet1").Range("A2:A" & LastA)
Set B = Sheets("Sheet1").Range("B2:B" & LastB)
Set C = Sheets("Sheet1").Range("C2:c" & LastC)
Set A2 = Sheets("Sheet2").Range("A" & count)
Set B2 = Sheets("Sheet2").Range("B" & count)
Set C2 = Sheets("Sheet2").Range("C" & count)
Sheets("Sheet2").Activate
A2.Activate
A.Copy Destination:=A2
A2.RemoveDuplicates Columns:=1, Header:=xlNo
A2.Columns.AutoFit
Sheets("Sheet1").Activate
LastA2 = Sheets("Sheet2").Cells(Rows.count, 1).End(xlUp).Row
Do Until count > LastA
CheckName = Sheets("Sheet1").Range("A" & count)
Name = CheckName
'creates a loop for the macro to go through the names on Sheet2
If count < LastA2 Then
CheckName2 = A2
Name2 = CheckName2
If Name = Name2 Then
B2 = B.Value
End If
count2 = count2 + 1
End If
count = count + 1
Loop
End Sub

Answer 1

You only have one loop. The place where your comment starts "create a loop" isn't a loop, it's an If statement. Here's how you might rewrite your code if I understand the logic correctly.
Sub PullNames()
Dim A As Range
Dim B As Range
Dim C As Range
Dim A2 As Range
Dim B2 As Range
Dim C2 As Range
Dim LastA As Long
Dim LastB As Long
Dim LastC As Long
Dim LastA2 As Long
Dim CheckName As String
Dim CheckName2 As String
Dim count As Long, count2 As Long
Dim Name_ As String
Dim Name2 As String
LastA = Sheets("Sheet1").Cells(Rows.count, 1).End(xlUp).Row
LastB = Sheets("Sheet1").Cells(Rows.count, 2).End(xlUp).Row
LastC = Sheets("Sheet1").Cells(Rows.count, 3).End(xlUp).Row
count = 2
Set A = Sheets("Sheet1").Range("A2:A" & LastA)
Set B = Sheets("Sheet1").Range("B2:B" & LastB)
Set C = Sheets("Sheet1").Range("C2:c" & LastC)
Set A2 = Sheets("Sheet2").Range("A" & count)
Set B2 = Sheets("Sheet2").Range("B" & count)
Set C2 = Sheets("Sheet2").Range("C" & count)
Sheets("Sheet2").Activate
A2.Activate
A.Copy Destination:=A2
A2.RemoveDuplicates Columns:=1, Header:=xlNo
A2.Columns.AutoFit
Sheets("Sheet1").Activate
LastA2 = Sheets("Sheet2").Cells(Rows.count, 1).End(xlUp).Row
Do Until count > LastA
CheckName = Sheets("Sheet1").Range("A" & count)
Name_ = CheckName
'creates a loop for the macro to go through the names on Sheet2
'If count < LastA2 Then
count2 = 2
Do While count2 <= LastA2
CheckName2 = Sheets("Sheet2").Range("A" & count2)
Name2 = CheckName2
If Name_ = Name2 Then
'B2 = B.Value
Sheets("Sheet2").Range("B" & count2).Value = Sheets("Sheet1").Range("B" & count).Value
End If
count2 = count2 + 1
Loop
'End If
count = count + 1
Loop
End Sub
If there are duplicates (that you removed), this code will pull the last value it encounters, which you may not want. If, for instance, B is a number, you may want to add those numbers together in column B.
Here's how I would have written the code.
Public Sub PullNames2()
Dim rCell As Range
Dim rFound As Range
Dim rNames As Range
'Define the range that contains the names
'copy that range to sheet2 and remove the dupes
Set rNames = Sheet1.Range("A2").CurrentRegion.Columns(1)
rNames.Copy Sheet2.Range("A2")
With Sheet2.Range("A2").CurrentRegion
.RemoveDuplicates 1, xlNo
.Columns.AutoFit
End With
'Loop through all the names
For Each rCell In rNames.Cells
'use the Find method to find the name on sheet2
Set rFound = Nothing
Set rFound = Sheet2.Columns(1).Find(rCell.Value, , xlValues, xlWhole)
'If you found the name, add the value in B to whatever is already there
If Not rFound Is Nothing Then
rFound.Offset(0, 1).Value = rFound.Offset(0, 1).Value + rCell.Offset(0, 1).Value
End If
Next rCell
End Sub
A couple of notes:
I use codenames of sheets. These are the names VBA knows and are not the tab names. You don't have to use them, it's just my preference.
CurrentRegion is good if you don't have any gaps. If it doesn't work for your data, you can set rNames however you like to define ranges. You'll just need to use the same methodology for sheet2.
You have to set rFound to Nothing every time because it will remember the last time it found something. That way you can check for Nothing - that's what rFound is if it can't find what it's looking for.
Always test code from the internet on a copy of your data. Particularly code that changes stuff.