Need help comparing numbers and generating a temporary 'no data found' message.

[toothless200]

I have a working Excel Macro that I've cobbled together from sources I've found on the internet.

It does what I want: it pastes usernames from the clipboard into a worksheet ("Bump") compares the resulting list to a list of users one the master list worksheet ("Reddit"), and then copies any new user names into the master list worksheet ("Reddit").

However, when it finds a user with a number for their name (e.g., '843564485), it will never find that name on the master worksheet, and copies it over every time.

Also, if it finds no matches, it errors out.

I'd like it to display a 'no matches' message for a few second on a pop-up, and then auto-close the pop-up message after a few seconds.

Any help would be appreciated.

Thanks!

Sub SelectBumpFinal()
'
' SelectBumpFinal Macro
' Macro recorded 9/26/2018 by Laptop2
'
' Keyboard Shortcut: Ctrl+k
'
Sheets("Bump").Select
Range("A1").Select
ActiveSheet.Paste
Range("A1:C1000").Select
Selection.Sort Key1:=Range("C1"), Order1:=xlDescending, Key2:=Range("B1") _
, Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:= _
False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, DataOption2 _
:=xlSortNormal

Dim TheSheet As Worksheet

If TypeOf ActiveSheet Is Worksheet Then

Set TheSheet = ActiveSheet

Else

Exit Sub

End If



Dim Row As Integer

Dim CellsToSelect As String

For Row = 1 To TheSheet.Range("C" & CStr(TheSheet.Rows.Count)).End(xlUp).Row


If TheSheet.Range("C" & CStr(Row)).Value = "No Match" Then

If CellsToSelect <> "" Then CellsToSelect = CellsToSelect & ","

CellsToSelect = CellsToSelect & "B" & CStr(Row)

End If

Next Row

TheSheet.Range(CellsToSelect).Select

Selection.Copy

Sheets("Reddit").Activate

ActiveCell.SpecialCells(xlCellTypeLastCell).Select

Application.Goto Cells(ActiveCell.Row, 1), 0

ActiveCell.Offset(1).PasteSpecial xlPasteValues

End Sub

[p45cal]

However, when it finds a user with a number for their name (e.g., '843564485), it will never find that name on the master worksheet, and copies it over every time.

It looks like there's a formula in column C of the Bump sheet. We'd need to know what that formula is. Also we need to know more about the number; is it a string which looks like a number (it looks like it might be a string if that leading apostrophe is in the cell). Also, what's it comparing it with on the Master sheet; is it a number or a string?
Ideally, supply a little workbook with the sheets concerned in, with something to copy from (to put into the clipboard) prior to running the macro. It doesn't need to be the whole shooting match, but the numbers/strings values need to be as they really are, both on the sheet to copy from and the Master sheet.

Also, if it finds no matches, it errors out.
I'd like it to display a 'no matches' message for a few second on a pop-up, and then auto-close the pop-up message after a few seconds.

I've done that in the code below except the message doesn't dismiss itself, you have to do that.

I've shortened the code and it doesn't need to select anything at all, so you won't see much happening on the screen while it's running and you'll have to switch to the sheets yourself to see the result (you could add aline at the end:Sheets("Reddit").activate if you want to end up seeing that sheet.

I couldn't see the point of the section of code beginning If TypeOf ActiveSheet Is Worksheet Then so I took it out… unless you know different.

Anyway, the code:

Sub SelectBumpFinal2()
Dim Row As Long, Destn As Range
Dim CellsToSelect As String
'determine destination cell first:
With Sheets("Reddit")
 Set Destn = .Cells(.Cells.SpecialCells(xlCellTypeLastCell).Row + 1, 1)
End With
'find what you want to copy:
With Sheets("Bump")
  .Range("A1").PasteSpecial Paste:=xlPasteAll
  .Range("A1:C1000").Sort Key1:=.Range("C1"), Order1:=xlDescending, Key2:=.Range("B1"), Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, DataOption2:=xlSortNormal
  For Row = 1 To .Range("C" & .Rows.Count).End(xlUp).Row
    If .Range("C" & Row).Value = "No Match" Then
      If CellsToSelect <> "" Then CellsToSelect = CellsToSelect & ","
      CellsToSelect = CellsToSelect & "B" & Row
    End If
  Next Row
 'do the copying:
 If Len(CellsToSelect) > 0 Then 'this will handle no matches.
  .Range(CellsToSelect).Copy
  Destn.PasteSpecial xlPasteValues
  Else
  MsgBox "No matches"
  End If
End With
End Sub

[toothless200]

Thanks, your changes worked.