Using a Combo box

[Max]

I was helped on this site by someone called Per.
He wrote this code for me that works very well. It is much appreciated.

This code compares two files for corresponding numbers in column B.
But I did not realise that it would cause a problem that I did not expect.
When a number does not show in one file a pop-up shows up. This is fine but
one of the files has more numbers than the other and this causes this pop-up
to show up more that i want it too.

Here is a possible solution. Insert a combo box into this code so that you
can select the number in either file to start with. Could you help with the
code for this insert or perhaps an alternative suggestion, but not to disable
the pop-up.

Here is the code. (the scrapy bit at the end was me).

Sub MergeData()
Dim wbA As Workbook
Dim wbB As Workbook
Dim shA As Worksheet
Dim shB As Worksheet
Dim IdRangeA As Range
Dim IdRangeB As Range
Dim IdCol As String
Dim FirstRow As Long, LastRowA As Long, LastRowB As Long

Set wbA = ThisWorkbook
Set wbB = Workbooks.Open(Application.GetOpenFilename)
Set shA = wbA.Worksheets("Sheet1")
Set shB = wbB.Worksheets("Sheet1")

IdCol = "B"
FirstRow = 2 ' Headings in row 1
LastRowA = shA.Range(IdCol & Rows.Count).End(xlUp).Row
LastRowB = shB.Range(IdCol & Rows.Count).End(xlUp).Row
Set IdRangeA = shA.Range(IdCol & FirstRow, IdCol & LastRowA)
Set IdRangeB = shB.Range(IdCol & FirstRow, IdCol & LastRowB)

For Each ID In IdRangeB
Set F = IdRangeA.Find(ID.Value, After:=shA.Range(IdCol & 2), _
LookIn:=xlValues, lookat:=xlWhole, SearchDirection:=xlNext)
If Not F Is Nothing Then
ID.Offset(0, 10).Resize(1, 1).Copy Destination:=F.Offset(0, 13)
Else
msg = MsgBox("Id " & ID.Value & " was not found in " & _
ActiveWorkbook.Name & vbLf & vbLf & _
"Click OK to continue", vbInformation, "Warning!")
End If
Next
wbB.Close
Range("O:O").Select
Selection.ClearFormats
Columns("O:O").EntireColumn.AutoFit
Range("O1").Select
wbA.Save
End Sub

Thank you for your help.

Max

 

[Per Jessen]

Hi again Max

I suggest we use a inputbox to allow the user to selet the cell with the
desired startnumber.
Furthermore I changed the code, so you will only get one pop-up listing all
numbers which wasn't found.

Sub MergeData()
Dim wbA As Workbook
Dim wbB As Workbook
Dim shA As Worksheet
Dim shB As Worksheet
Dim IdRangeA As Range
Dim IdRangeB As Range
Dim StartA As Range
Dim StartB As Range
Dim IdCol As String
Dim NotFound As String
Dim FirstRowA As Long, FirstRowB, LastRowA As Long, LastRowB As Long

Set wbA = ThisWorkbook
Set shA = wbA.Worksheets("Sheet1")
Do
Set StartA = Application.InputBox _
("Select the cell in column B with the number to start with in " _
& wbA.Name, "Select start number", , , , , , 8)
Loop Until StartA.Column = 2

Set wbB = Workbooks.Open(Application.GetOpenFilename)
Set shB = wbB.Worksheets("Sheet1")
Do
Set StartB = Application.InputBox _
("Select the cell in column B with the number to start with in " _
& wbA.Name, "Select start number", , , , , , 8)
Loop Until StartB.Column = 2

IdCol = "B"
FirstRowA = StartA.Row
FirstRowB = StartB.Row
LastRowA = shA.Range(IdCol & Rows.Count).End(xlUp).Row
LastRowB = shB.Range(IdCol & Rows.Count).End(xlUp).Row
Set IdRangeA = shA.Range(IdCol & FirstRowA, IdCol & LastRowA)
Set IdRangeB = shB.Range(IdCol & FirstRowB, IdCol & LastRowB)

For Each ID In IdRangeB
Set F = IdRangeA.Find(ID.Value, After:=shA.Range(IdCol & FirstRowA), _
LookIn:=xlValues, lookat:=xlWhole, SearchDirection:=xlNext)
If Not F Is Nothing Then
ID.Offset(0, 10).Resize(1, 1).Copy Destination:=F.Offset(0, 13)
Else
If NotFound = "" Then
NotFound = ID.Value
Else
NotFound = NotFound & ", " & ID.Value
End If
End If
Next
wbB.Close
If NotFound <> "" Then
msg = MsgBox("Id(s)" & vbLf & NotFound & vbLf & " was not found in " & _
ActiveWorkbook.Name & vbLf & vbLf & _
"Click OK to continue", vbInformation, "Warning!")
End If
Range("O:O").ClearFormats
Columns("O:O").EntireColumn.AutoFit
Range("O1").Select
wbA.Save
End Sub

Regards,
Per

 

[Max]

Hello Per,
What can I say, your idea was better and it works perfectly.

Well done and thank you very much. You have made life much easier for me.

Best regards

Max