How to add a msg box in VBA code instead if error code 457 pops up?

Indominus

Board Regular
Joined
Jul 11, 2020
Messages
160
Office Version
  1. 2016
Platform
  1. Windows
Hello. I have this VBA code that copies and pastes data from one workbook to another. However, sometimes it results in error code 457, which says "this key is already associated with an element of this collection." Is there anyway to have a msg box pop up if this error occurs instead with custom text I input. Here is the code. Thanks to anyone willing to help.

VBA Code:
[/
Sub copyandpastec2()

    Dim bk As Workbook
    Dim dict As Object
    Dim cell As Range
    Dim Sht As Worksheet

    For Each bk In Application.Workbooks
        If UCase(bk.Name) Like UCase("*Pick*order*") Then Exit For
    Next bk

    If bk Is Nothing Then
        MsgBox "Workbook not found", vbCritical
        Exit Sub
    End If

    Set dict = CreateObject("scripting.dictionary")

    For Each cell In bk.Sheets(1).Range("B2:B" & bk.Sheets(1).Range("B1048576").End(xlUp).Row)
        dict.Add Trim$(cell.Offset(0, 2).Value2), Array(abbrev_dsp(cell.Offset(0, 3).Value2), cell.Value2)
    Next cell

    If dict.Count = 0 Then
        MsgBox "Data not found", vbCritical
        Exit Sub
    End If

    Set Sht = ThisWorkbook.Sheets("Wave Plan")

    For Each cell In Sht.UsedRange
        If cell.Value2 <> vbNullString And dict.exists(Trim$(cell.Value2)) Then
            For i = 1 To 5
                With cell.Offset(0, i)
                    If Trim$(Sht.Cells(3, .Column).Value2) = dict(Trim$(cell.Value2))(0) Then
                        .Value2 = dict(Trim$(cell.Value2))(1)
                        Exit For
                    End If
                End With
            Next i
        End If
    Next cell

    End Sub
    Function abbrev_dsp(dspCode As String) As String
    Select Case Trim$(dspCode)
    Case "A"
        dspCode = "AW"
    Case "J"
        dspCode = "JP"
    Case "H"
        dspCode = "HQ"
    End Select
    abbrev_dsp = Trim$(dspCode)
    End Function

]
 

Excel Facts

Waterfall charts in Excel?
Office 365 customers have access to Waterfall charts since late 2016. They were added to Excel 2019.
How about
VBA Code:
    For Each cell In bk.Sheets(1).Range("B2:B" & bk.Sheets(1).Range("B1048576").End(xlUp).row)
        If dict.Exists(Trim$(cell.Offset(0, 2).Value2)) Then
           MsgBox "Whatever you want to say"
        Else
           dict.Add Trim$(cell.Offset(0, 2).Value2), Array(abbrev_dsp(cell.Offset(0, 3).Value2), cell.Value2)
        End If
    Next cell
 
Upvote 0
Solution
How about
VBA Code:
    For Each cell In bk.Sheets(1).Range("B2:B" & bk.Sheets(1).Range("B1048576").End(xlUp).row)
        If dict.Exists(Trim$(cell.Offset(0, 2).Value2)) Then
           MsgBox "Whatever you want to say"
        Else
           dict.Add Trim$(cell.Offset(0, 2).Value2), Array(abbrev_dsp(cell.Offset(0, 3).Value2), cell.Value2)
        End If
    Next cell
Works perfectly! Thank you so much!
 
Upvote 0
You're welcome & thanks for the feedback.
 
Upvote 0
You're welcome & thanks for the feedback.
I actually have a question about the line of code you added. I am trying to learn more about VBA. What makes the code continue on after the error (message box) pops up? It never did it before. The code ended there. I love it.
 
Upvote 0
It checks to see if the value is already in the dictionary, thereby preventing an error from occurring.
 
Upvote 0
You're welcome & thanks for the feedback.
 
Upvote 0

Forum statistics

Threads
1,215,824
Messages
6,127,108
Members
449,359
Latest member
michael2

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