Msgbox question

ipbr21054

Well-known Member
Joined
Nov 16, 2010
Messages
5,199
Office Version
  1. 2007
Platform
  1. Windows
Morning,

The code supplied below alerts me of a Duplicate no problem at all.

Code:
Private Sub CommandButton2_Click()
    Dim cell As Range
 
    With Intersect(ActiveSheet.Columns("A"), ActiveSheet.UsedRange)
        For Each cell In .Cells
            If WorksheetFunction.CountIf(.Resize(cell.Row - .Rows(1).Row + 1), cell.Value) > 1 Then MsgBox "Duplicate Item Number " & cell.Value & "  in cell " & cell.Address(False, False), vbCritical, "DUPLICATE ITEM NUMBER CHECKER"
           
        Next cell
    End With
 
End Sub

But if no Duplicates are found i dont see a message to say No duplicates found etc.
So i tried the code below but its incorrect,can you advise please the correct code.

Thanks.

Code:
Private Sub CommandButton2_Click()    Dim cell As Range


    With Intersect(ActiveSheet.Columns("A"), ActiveSheet.UsedRange)
        For Each cell In .Cells
            If WorksheetFunction.CountIf(.Resize(cell.Row - .Rows(1).Row + 1), cell.Value) > 1 Then MsgBox "Duplicate Item Number " & cell.Value & "  in cell " & cell.Address(False, False), vbCritical, "DUPLICATE ITEM NUMBER CHECKER"
            
        Next cell
        Else
        MsgBox "No Duplicate Items Were Present", , "DUPLICATE ITEM NUMBER CHECKER"
        End If
    End With


End Sub
 

Excel Facts

Lock one reference in a formula
Need 1 part of a formula to always point to the same range? use $ signs: $V$2:$Z$99 will always point to V2:Z99, even after copying
How do you want this to work in practice? Do you really want a message for every duplicate before you can do anything about them, or do you want to simply notify the first duplicate and then stop so it can be corrected?
 
Upvote 0
Morning,
That would be better but wasnt sure how to do it.

Also a message to advise if nothing was found.

Have a nice day
 
Upvote 0
I'd suggest something like this:

Code:
Private Sub CommandButton2_Click()
    Dim cell As Range


    With Intersect(ActiveSheet.Columns("A"), ActiveSheet.UsedRange)
        For Each cell In .Cells
            If WorksheetFunction.CountIf(.Resize(cell.Row - .Rows(1).Row + 1), cell.Value) > 1 Then
             MsgBox "Duplicate Item Number " & cell.Value & "  in cell " & cell.Address(False, False) & vbLf & "Please correct and run this again.", vbCritical, "DUPLICATE ITEM NUMBER CHECKER"
             cell.select
             exit sub
           end if
            
        Next cell

    End With
    MsgBox "No Duplicate Items Were Present", , "DUPLICATE ITEM NUMBER CHECKER"

End Sub
 
Last edited:
Upvote 0
Thanks.

I run the code.
I see the msgbox so i click on ok.
I then delete the duplicate.
Then a message box pops up,run time error 1004, Application defined or Object defined error
Clicking on debug the line of code below is shown,also its code is shown below that.

If shp.Type = msoPicture And shp.TopLeftCell.Address = Target.Offset(0, 1).Address Then


Code:
Private Sub Worksheet_Change(ByVal Target As Range)    Dim shp                   As Shape
    Dim picPath               As String
    Dim vFile


    picPath = "C:\Users\Ian\Desktop\SKYPE\LOCK PICK ME\"


    If Intersect(Target, [A:A]) Is Nothing Then Exit Sub
    If Target.Row Mod 20 = 0 Then Exit Sub
    On Error GoTo son


    For Each shp In ActiveSheet.Shapes
        If shp.Type = msoPicture And shp.TopLeftCell.Address = Target.Offset(0, 1).Address Then
            shp.Delete
        End If
    Next


    If Target.Value <> "" Then
        ChDrive picPath
        ChDir picPath
        picPath = picPath & Target.Value & ".jpg"
        If Dir(picPath) = "" Then    'picture not there!
            If MsgBox("Photo " & Target.Value & " Doesn't exist" & vbCrLf & "Open The Picture Folder ?", vbCritical + vbYesNo, "No Photo Found") = vbYes Then
                ' prompt to select the picture file
                vFile = Application.GetOpenFilename(filefilter:="JPEG image files (*.jpg), *.jpg", Title:="Select image file")
                ' exit if they cancelled
                If vFile = False Then
                    Exit Sub
                Else
                    picPath = vFile
                End If
            Else
                Exit Sub
            End If
        End If
    With Target.Offset(0, 1)
        Set shp = ActiveSheet.Shapes.AddPicture(Filename:=picPath, _
                                                linktofile:=msoFalse, savewithdocument:=msoTrue, _
                                                Left:=.Left + 5, Top:=.Top + 5, Width:=-1, Height:=-1)    ' -1 means use default size
        shp.LockAspectRatio = msoFalse
        shp.Height = .Height - 10
        shp.Width = .Width - 10
    End With
    End If
son:


End Sub
 
Upvote 0
That's a different question so I suggest you post it as such, please.
 
Upvote 0

Forum statistics

Threads
1,213,560
Messages
6,114,309
Members
448,564
Latest member
ED38

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top