Comparing different columns to FIND same Customer Name and then do Conditional Copy P

happy1001

Registered User.
Local time
Today, 13:30
Joined
Aug 9, 2014
Messages
11
I have got 2 lists in 2 separate sheets in the same excel file. The Small list has got 20 Customer Names in it and the Big list has got 50 Customer Names in it.

I need to compare the names given in the BIG List, with the names given in the SMALL List and then if there is a match of name, then copy paste the values from Product A to the corresponding Product A in another sheet and so on for other products as well.

If some Name is not present in the Small list, then the formula should write “NOT FOUND” in front of that name in the Big List, in Product A Column and leave other columns empty.

What would be the best way to do this?

Thanks a lot
 

Attachments

  • - Sample Sheet for Comparison Work.zip
    - Sample Sheet for Comparison Work.zip
    6.6 KB · Views: 164
  • - Comparison.png
    - Comparison.png
    30.4 KB · Views: 173
This Excel does contain VBA code and will probably warn you about that.
I added a button to call the code and another button to clear the results so you can try it over, and over, and over.... :)

I just happened to be doing something like this for a client who is downloading automated Excel reports from Access reports that use Excel Object Model Programming to create the Excel reports.
They wanted to look up comparisons.
This is an extremely simple version of my short task.
So, you were in luck that I was gracious enough to share it this Sunday morning.

For those of you with download filters, here is the code behind the buttons in the Sheet2 Code module.
Code:
Option Explicit
 
Private Sub AutoLookup()
      ' leave this on Big List when running code
      'Application.ScreenUpdating = False
      Dim WorkSheet2 As Worksheet, WorkSheet1 As Worksheet
      Dim f As Range, frmNum
      Dim lastLine As Long
      Dim WhyDoIExist As Integer ' didn't need it after all
      Dim RowNumber As Integer
10    On Error GoTo ErrTrap
20    Set WorkSheet2 = Sheets("Big List")
30    Set WorkSheet1 = Sheets("Small List")
40    lastLine = WorkSheet2.UsedRange.Rows.Count - 1 ' took out your "This Column has got complete 50 Customer Names"
50    For RowNumber = 2 To lastLine
60        frmNum = WorkSheet2.Cells(RowNumber, 1).Value
70        Debug.Print "in Big List, looking up " & frmNum
80        If Len(frmNum) > 0 Then
90            Set f = WorkSheet1.Columns(1).Find(frmNum, LookIn:=xlValues, lookat:=xlWhole)
100           If Not f Is Nothing Then
110               f.Offset(0, 1).Resize(1, 5).Copy WorkSheet2.Cells(RowNumber, 2)
120           Else
130               WorkSheet2.Cells(RowNumber, 2).Value = "Not Found" 'You can put this where you want it
140           End If
150       End If
160   Next RowNumber
170   Exit Sub
ErrTrap:
180   Debug.Print "Resistance is Useless You will be Assemilated " & Err.Description
End Sub
 
Private Sub cmdClear_Click()
      ' Rx prescribes solutions
      ' ClearListToTryAgain Macro
On Error GoTo Hell
10        Range("B2:E10").Select
20        Selection.ClearContents
30        Range("B2").Select
Exit Sub
Hell:
    Debug.Print "welcome to debug hell " & Err.Description
End Sub
 
Private Sub cmdMatchMaker_Click()
10  AutoLookup
End Sub
 

Attachments

Last edited:
This Excel does contain VBA code and will probably warn you about that.
I added a button to call the code and another button to clear the results so you can try it over, and over, and over.... :)

I just happened to be doing something like this for a client who is downloading automated Excel reports from Access reports that use Excel Object Model Programming to create the Excel reports.
They wanted to look up comparisons.
This is an extremely simple version of my short task.
So, you were in luck that I was gracious enough to share it this Sunday morning.

For those of you with download filters, here is the code behind the buttons in the Sheet2 Code module.
Code:
Option Explicit
Private Sub AutoLookup()
      ' leave this on Big List when running code
      'Application.ScreenUpdating = False
      Dim WorkSheet2 As Worksheet, WorkSheet1 As Worksheet
      Dim f As Range, frmNum
      Dim lastLine As Long
      Dim WhyDoIExist As Integer ' didn't need it after all
      Dim RowNumber As Integer
10    On Error GoTo ErrTrap
20    Set WorkSheet2 = Sheets("Big List")
30    Set WorkSheet1 = Sheets("Small List")
40    lastLine = WorkSheet2.UsedRange.Rows.Count - 1 ' took out your "This Column has got complete 50 Customer Names"
50    For RowNumber = 2 To lastLine
60        frmNum = WorkSheet2.Cells(RowNumber, 1).Value
70        Debug.Print "in Big List, looking up " & frmNum
80        If Len(frmNum) > 0 Then
90            Set f = WorkSheet1.Columns(1).Find(frmNum, LookIn:=xlValues, lookat:=xlWhole)
100           If Not f Is Nothing Then
110               f.Offset(0, 1).Resize(1, 5).Copy WorkSheet2.Cells(RowNumber, 2)
120           Else
130               WorkSheet2.Cells(RowNumber, 2).Value = "Option Explicit"
Private Sub AutoLookup()
      ' leave this on Big List when running code
      'Application.ScreenUpdating = False
      Dim WorkSheet2 As Worksheet, WorkSheet1 As Worksheet
      Dim f As Range, frmNum
      Dim lastLine As Long
      Dim WhyDoIExist As Integer ' didn't need it after all
      Dim RowNumber As Integer
10    On Error GoTo ErrTrap
20    Set WorkSheet2 = Sheets("Big List")
30    Set WorkSheet1 = Sheets("Small List")
40    lastLine = WorkSheet2.UsedRange.Rows.Count - 1 ' took out your "This Column has got complete 50 Customer Names"
50    For RowNumber = 2 To lastLine
60        frmNum = WorkSheet2.Cells(RowNumber, 1).Value
70        Debug.Print "in Big List, looking up " & frmNum
80        If Len(frmNum) > 0 Then
90            Set f = WorkSheet1.Columns(1).Find(frmNum, LookIn:=xlValues, lookat:=xlWhole)
100           If Not f Is Nothing Then
110               f.Offset(0, 1).Resize(1, 5).Copy WorkSheet2.Cells(RowNumber, 2)
120           Else
130               WorkSheet2.Cells(RowNumber, 2).Value = "Not Found" 'You can put this where you want it
140           End If
150       End If
160   Next RowNumber
170   Exit Sub
ErrTrap:
180   Debug.Print "Resistance is Useless You will be Assemilated " & Err.Description
End Sub

Private Sub cmdClear_Click()
      ' Rx prescribes solutions
      ' ClearListToTryAgain Macro
On Error GoTo Hell
10        Range("B2:E10").Select
20        Selection.ClearContents
30        Range("B2").Select
Exit Sub
Hell:
    Debug.Print "welcome to debug hell " & Err.Description
End Sub

Private Sub cmdMatchMaker_Click()
AutoLookup
End Sub
" 'This value isn't necessary, it just demonstrates I confirmed visiting it
140           End If
150       End If
160   Next RowNumber
170   Exit Sub
ErrTrap:
180   Debug.Print "Resistance is Useless You will be Assemilated " & Err.Description
End Sub

Private Sub cmdClear_Click()
      ' Rx prescribes solutions
      ' ClearListToTryAgain Macro
On Error GoTo Hell
10        Range("B2:E10").Select
20        Selection.ClearContents
30        Range("B2").Select
Exit Sub
Hell:
    Debug.Print "welcome to debug hell " & Err.Description
End Sub

Private Sub cmdMatchMaker_Click()
10       AutoLookup
End Sub

WOW thanks a ton for sharing it along with the Code. It works like a charm. I am very grateful that you decided to share it.

If this is just an extremely simple version of the task that you are involved in, then the whole comparison work would be something real complicated, I guess. As I was having a tough time in even defining my current comparison conditions.

With my best regards
 
Hi Rx_ !

When I went through your complete code, I realized that your commenting style is just - AWESOME :D

Really enjoyed it.

Thanks and regards
 
As the poster - you can re-visit and mark the question as "solved"

Realized that the code did some kind of wierd insert update.
The code on the top is fixed so there are not two subs with the same name.
Sorry about that.

Checked the attachment, it works just fine.
 
As the poster - you can re-visit and mark the question as "solved"

Realized that the code did some kind of wierd insert update.
The code on the top is fixed so there are not two subs with the same name.
Sorry about that.

Checked the attachment, it works just fine.

Thanks for the correction Rx_

I just marked the thread as solved.

Thanks for providing the code again :)
 
  • Like
Reactions: Rx_
LOL, change that to "So, you were in luck that I was sober enough to share it this Sunday morning."
 

Users who are viewing this thread

Back
Top Bottom