Run time - error '457'

javiervargas · el 9 de abril

Buenos dias

Quisiera saber si alguien me puede explicar la razon por la cual aparece el sigiente error cuando ejecuto una macro de userform: Run time - Error '457': this key is already associated with an element of this collection.

Como lo mencione el problema surge es en formularios, pero no me dice a cual linea pertenece el error, y por lo que logro evidenciar es que existe un conflicto entre estos dos formularios ya que al ejecutar uno de estos, el otro ya no se puede ejecutar y la unica forma de que vuelvan a funcionar es desde el codigo.

bigpetroman · el 9 de abril

Tienes 5 mensajes y un me gusta recibido, pero creo que aún no has leido las normas verdad?

Normas y Reglas del Foro | Ayuda Excel

deberías leerlas y luego completar tu consulta (por si acaso no lo consigues, debes subir un archivo explicando el problema que tienes).

una ayuda extra; ejecutando el código en modo paso a paso (presionando F8) lograras ver exactamente cual línea de tu código genera el error.

suerte

Antoni · el 9 de abril

El error es muy claro, se intenta añadir un elemento a una colección y el nombre ya existe.

Como no has subido el archivo no se puede hacer nada. Aquí te dejo varios links sobre el tema:

Run time - Error '457': this key is already associated with an element of this collection. - Buscar con Google

javiervargas · el 10 de abril

Bueno ya revise el codigo de formulario paso a paso como me sugirio bigpetroman y el problema aparece en la siguiente linea :

"arrnombrehta.Add nombrehta, nombrehta

Next nombrehta"

para el formulario "Busqueda Rapida"

Private Sub UserForm_Initialize()

With MultiPage1.Pages(0)


Dim arrnombrepf As New Collection, nombrepf

    Dim iG As Integer


    On Error Resume Next

  ComboBox1.Clear

    On Error GoTo 0


    With Sheets("Nombres Product Family")

        On Error Resume Next

            For Each nombrepf In Range("tblnombrepf")

                arrnombrepf.Add nombrepf, nombrepf

            Next nombrepf

        On Error GoTo 0

        For iG = 1 To arrnombrepf.Count

            ComboBox1.AddItem (arrnombrepf(iG))


                  Next iG


    End With

    End With


'-------------------------------------------------------------------------

      'la siguiente programacion permite buscar un pf en la pagina de busqueda por pf

    With MultiPage1.Pages(1)

Dim arrpf As New Collection, profam

    Dim iP As Integer


        On Error Resume Next

  ComboBox4.Clear

    On Error GoTo 0


    With Sheets("informacion")

        On Error Resume Next

            For Each profam In Range("tablapf")

                arrpf.Add profam, profam

            Next profam

        On Error GoTo 0

        For iP = 1 To arrpf.Count

            ComboBox4.AddItem (arrpf(iP))


    Next iP


    End With

    End With

'-------------------------------------------------------------------------

MultiPage1.Pages(0).Enabled = True

MultiPage1.Pages(1).Enabled = True

MultiPage1.Value = 0 ' para que me seleccione la primera pagina simpre que inicie la busqueda


End Sub


'traer pf asociado al nombre(esto para la pagina de busqueda por nombre


Private Sub ComboBox1_Change()

'Dim rngCell As Range

    Dim arrprodfam As New Collection, prodfam

    Dim iR As Integer


    On Error Resume Next

    ComboBox2.Clear

    On Error GoTo 0


    With Sheets("Nombres Product Family")

        On Error Resume Next

            For Each prodfam In Range("tblpfparabusqueda")

                If prodfam.Offset(0, -1).Value = ComboBox1 Then

                arrprodfam.Add prodfam, prodfam

            End If

            Next prodfam

        On Error GoTo 0

        For iR = 1 To arrprodfam.Count

        ComboBox2.AddItem (arrprodfam(iR))

        Next iR

        End With


End Sub


'traer commodity asociados al pf(para la pagina de busqueda por nombre)


Private Sub ComboBox2_Change()

'Dim rngCell As Range

    Dim arrcommodity As New Collection, comm

    Dim iL As Integer


    On Error Resume Next

    ComboBox3.Clear

    On Error GoTo 0


    With Sheets("informacion")

        On Error Resume Next

            For Each comm In Range("tablacommodity")

                If comm.Offset(0, -1).Value = ComboBox2 Then

                arrcommodity.Add comm, comm

            End If

            Next comm

        On Error GoTo 0

        For iL = 1 To arrcommodity.Count

        ComboBox3.AddItem (arrcommodity(iL))

        Next iL


        End With

Range("ah8").Value = ComboBox2.Value 'devuelve el valor del pf a la celda especificada(busueda por nombre)

End Sub


'traer commodity asociados al pf(para la pagina de busqueda por pf)


Private Sub ComboBox4_Change()


'Dim rngCell As Range

    Dim arrcommodities As New Collection, commo

    Dim iT As Integer


    On Error Resume Next

    ComboBox5.Clear

    On Error GoTo 0


    With Sheets("informacion")

        On Error Resume Next

            For Each commo In Range("tablacommodity")

                If commo.Offset(0, -1).Value = ComboBox4 Then

                arrcommodities.Add commo, commo

            End If

            Next commo

        On Error GoTo 0

        For iT = 1 To arrcommodities.Count

        ComboBox5.AddItem (arrcommodities(iT))


        Next iT

        End With

    Range("ah8").Value = ComboBox4.Value 'devuelve el valor del pf a la celda especificada(busueda por pf)


End Sub


'-------------------para ingresar los valores seleccionados en los combobox a las celdas requeridas---------------------

Private Sub ComboBox5_Change()

Range("ah10").Value = ComboBox5.Value  'devuelve el valor del commodity a la celda especificada(busqueda por pf)

End Sub


Private Sub ComboBox3_Change()

Range("ah10").Value = ComboBox3.Value  'devuelve el valor del commodity a la celda especificada(busqueda por nombre)

End Sub

[/CODE]

pero dado la condicion de mi codigo y la forma en que yo he ido trabajandolo no se como solucionar el problema, pues todo lo que he hecho hasta el momento ha sido mediante tutoriales en internet sobre programacion vba y no llevo mas de dos meses en esto asi que soy muy novato. cuando ejecuto un boton "busqueda rapida" me funciona en la mayoria de la veces bien, pero cuando ejecuto el boton del formulario "ensamble"

[CODE]Private Sub CommandButton2_Click()
Unload Me
End Sub

'codigo para almacenar los nombres de las hts de los ensambles en el combobox1
Private Sub UserForm_Initialize()
Dim arrnombrehta As New Collection, nombrehta
Dim H As Integer
On Error Resume Next
ComboBox1.Clear
On Error GoTo 0

With Sheets("Ensambles")
On Error Resume Next
For Each nombrehta In Range("tbl_hta_ensamble")
arrnombrehta.Add nombrehta, nombrehta
Next nombrehta
On Error GoTo 0
For H = 1 To arrnombrehta.Count
ComboBox1.AddItem (arrnombrehta(H))
Next H
End With
End Sub

'Codigo para traer al combobox2 los commodity asociados a la hta.
Private Sub ComboBox1_Change()
'Dim rngCell As Range
Dim arrcomm_ensamblado As New Collection, comm_ensamblado
Dim C As Integer

On Error Resume Next
ComboBox2.Clear
On Error GoTo 0

With Sheets("Ensambles")
On Error Resume Next
For Each comm_ensamblado In Range("tbl_commodity_ensamble")
If comm_ensamblado.Offset(0, -1).Value = ComboBox1 Then
arrcomm_ensamblado.Add comm_ensamblado, comm_ensamblado
End If
Next comm_ensamblado
On Error GoTo 0
For C = 1 To arrcomm_ensamblado.Count
ComboBox2.AddItem (arrcomm_ensamblado(C))
Next C
End With
End Sub[/CODE]

y posteriormente vuelvo a ejecutar "Busqueda Rapida", este ya no funciona ni tampoco el de "Ensamble". Espero que me puedan hacer el favor de colaborarme y tal vez es sugerir otra forma para hacer el formulario con colecciones.

quedo atento

bigpetroman · el 10 de abril

el maestro @[uSER=46507]Macro Antonio[/uSER] te indico cual es el problema, y como te indique anteriormente

debes subir un archivo explicando el problema que tienes

con el código nada mas no se puede hacer mucho, pareciera estar bien, pero solo con el código no podran ayudarte, suerte

javiervargas · el 10 de abril

ok, ya subo el archivo. los codigos donde veo problema son de los userform 3 y 4. basicamente cuando lo ejecuto por primera vez funciona correctamente, pero posteriormente no vuelve a funcionar.

gracias

copia.zip

bigpetroman · el 10 de abril

Amigo, algunas cositas que de seguro te ayudaran

1.- revisa los nombres de rangos, por ejemplo los nombres tablapf y tablacommodity, tiene una referencia eliminada por lo cual dichos nombres siempre daran error al trabajar con ellos

2.- este codigo

Private Sub UserForm_Initialize()

With MultiPage1.Pages(0)

Dim arrnombrepf As New Collection, nombrepf

    Dim iG As Integer


    On Error Resume Next

  ComboBox1.Clear

    On Error GoTo 0


    With Sheets("Nombres Product Family")

        On Error Resume Next

            For Each nombrepf In Range("tblnombrepf")

                arrnombrepf.Add nombrepf, nombrepf

            Next nombrepf

        On Error GoTo 0

        For iG = 1 To arrnombrepf.Count

            ComboBox1.AddItem (arrnombrepf(iG))


                  Next iG


    End With

    End With

'-------------------------------------------------------------------------

      'la siguiente programacion permite buscar un pf en la pagina de busqueda por pf

    With MultiPage1.Pages(1)

Dim arrpf As New Collection, profam

    Dim iP As Integer


        On Error Resume Next

  ComboBox4.Clear

    On Error GoTo 0


    With Sheets("informacion")

        On Error Resume Next

            For Each profam In Range("tablapf")

                arrpf.Add profam, profam

            Next profam

        On Error GoTo 0

        For iP = 1 To arrpf.Count

            ComboBox4.AddItem (arrpf(iP))


    Next iP

    End With

    End With

'-------------------------------------------------------------------------

MultiPage1.Pages(0).Enabled = True

MultiPage1.Pages(1).Enabled = True

MultiPage1.Value = 0 ' para que me seleccione la primera pagina simpre que inicie la busqueda

End Sub[/CODE]

podrías cambiarlo por este otro

[CODE]Private Sub UserForm_Initialize()
Dim arrnombrepf As New Collection, nombrepf
Dim iG As Integer
Dim arrpf As New Collection, profam
Dim iP As Integer

'la siguiente programacion permite ingresar y buscar la hta por su nombre

On Error Resume Next
ComboBox1.Clear
On Error GoTo 0

On Error Resume Next
For Each nombrepf In Range("tblnombrepf")
arrnombrepf.Add nombrepf, nombrepf
On Error GoTo 0
Next nombrepf

For iG = 1 To arrnombrepf.Count
ComboBox1.AddItem (arrnombrepf(iG))
Next iG

'-------------------------------------------------------------------------
'la siguiente programacion permite buscar un pf en la pagina de busqueda por pf

On Error Resume Next
ComboBox4.Clear
On Error GoTo 0

On Error Resume Next
For Each profam In Range("tablapf")
arrpf.Add profam, profam
On Error GoTo 0
Next profam

For iP = 1 To arrpf.Count
ComboBox4.AddItem (arrpf(iP))
Next iP

'-------------------------------------------------------------------------
MultiPage1.Pages(0).Enabled = True
MultiPage1.Pages(1).Enabled = True
MultiPage1.Value = 0 ' para que me seleccione la primera pagina simpre que inicie la busqueda

End Sub[/CODE]

como ves, se eliminaron estos codigos del tipo [b]With Sheets("Nombres Product Family")[/b], ya que como esta planteado pues no hace nada

inclusive podrias cambiar esto

[CODE]On Error Resume Next
For Each profam In Range("tablapf")
arrpf.Add profam, profam
On Error GoTo 0
Next profam

For iP = 1 To arrpf.Count
ComboBox4.AddItem (arrpf(iP))
Next iP[/CODE]

por esto otro

[CODE]For Each profam In Range("tablapf")
ComboBox4.AddItem profam
Next profam[/CODE]

ya que no tiene sentido (así como está planteado) pasar los datos a un array y luego pasarlo al combobox, a menos que fueras a usar el array luego para otra cosa

intenta poner esto en practica, cualquier cosa no dudes en consultar

javiervargas · el 11 de abril

Gracias por esa gran ayuda bigpetroman.

por alguna razon el archivo que subi tenia los errores de los rangos que me indico, pero el archivo original que tengo no tiene esos problemas. respecto a la recomendacion para cambiar por el ultimo codigo corto, resulta que me agraga todos los valores asi esten repetidos, y necesito que solo queden valores unicos. como quedaria el codigo resumido cumpliendo la condicion de que solo tome los valores unicos?

De nuevo gracias por su tiempo

javiervargas · el 11 de abril

realice los cambios que me sugirio, ademas de la correccion a los rangos y me sigue apareciendo el error typo 457. adjunto el archivo corregido para ver si se puede determinar cual es el problema.

gracias

copia.zip

bigpetroman · el 12 de abril

revisa el anexo amigo, yo ejecuto los 2 formularios y no sucede ningún error.

Ejemplo javiervargas.rar

Antoni · el 12 de abril

.

A ver, @[uSER=133908]bigpetroman[/uSER] ya te ha dado la solución a tu error, pero me gustaría que entendierás porqué te da el error.

Entre otras cosas, una colección contiene un valor y una clave, los valores pueden estar duplicados tantas veces como quieras, pero la clave debe ser única.

Dado que utilizas el valor como clave, a la que encuentra un valor duplicado, cosa que sucede, se produce un error.

Hay dos formas de solucionar esto, obviando el error con On Error Resume Next, o añadiendo un correlativo añadido al final de la clave, en este último caso, los duplicados se añadirán a la colección.

Como parece que lo que tu quieres es cargar los combos con valores únicos, lo mas comodo es la primera opción.

Eso es lo que tu has pretendido hacer, pero mal.

Debes eliminar todos los On Error GoTo 0 antes de cada Next, ya que On Error GoTo 0 desactiva lo hecho por On Error Resume Next.

Ejemplo:

On Error Resume Next

For Each nombrehta In Range("tbl_hta_ensamble")

n = n + 1

arrnombrehta.Add nombrehta, n

On Error GoTo 0

Next nombrehta

No obstante la forma mas cómoda de cargar un combobox sin duplicados es utilizar la propiedad .ListIndex del ComboBox.

Ejemplo:

ComboBox1.Clear

For Each nombrehta In Range("tbl_hta_ensamble")

  ComboBox1.Text = nombrehta.Value

  If ComboBox1.ListIndex = -1 Then 'No es duplicado

      ComboBox1.AddItem nombrehta.Value

  End If

ComboBox1.Text = ""

Next[/CODE]

[/b]

Espero que te hayamos ayudado a entender un poco mas los C[b]omboBox[/b], las [b]colecciones [/b]y la instrucción[b] On Error.[/b]

.

javiervargas · el 16 de abril

gracias por esa ayuda tan grande.

perdonen mi ignorancia, pero quiero quedar seguro de que entendi bien acerca del on error resume next, ya que segun entendi NO LO DEBO UTILIZAR. por otro lado me parece mucho mas practico el metodo de .listindex para evitar los duplicados y me gustaria usar este metodo pero estuve haciendo pruebas y no se porque razon se pone mas lento al ejecutar la macro cuando uso este metodo y por otro lado necesito traer valores dependientes cada item presente en el combobox y use el siguiente codigo:

'traer products family asociados al nombre


Private Sub ComboBox1_Change()


    On Error Resume Next

    ComboBox2.Clear

    On Error GoTo 0


            For Each prodfam In Range("tblpfparabusqueda")

                If prodfam.Offset(0, -1).Value = ComboBox1 Then

                    ComboBox2.AddItem prodfam.Value

                    End If

                    ComboBox2.Text = ""

        Next



End Sub[/CODE]

pero la verdad no me convence, ya que necesito copiar el valor de este combobox a una celda y cuando ejecuto la macro pasan todos los valores por esa celda antes de que se muestre el formulario. me gustaria la sugerencia de un experto para solucionar y dar por terminao este tema.

agradezco por tiempo

bigpetroman · el 18 de abril

amigo, sube tu archivo como lo tienes ahora e indica cual serìa el problema para revisarlo, suerte

javiervargas · el 21 de abril

como le decia, necesito traer valores dependientes al valor de un combobox

Private Sub ComboBox1_Change()

    On Error Resume Next

    ComboBox2.Clear

    On Error GoTo 0


            For Each prodfam In Range("tblpfparabusqueda")

                If prodfam.Offset(0, -1).Value = ComboBox1 Then

                    ComboBox2.AddItem prodfam.Value

                    End If

                    ComboBox2.Text = ""

        Next

End Sub[/CODE]

y siguiendo la indicaciones de Macro Antonio logre hacerlo pero resulta que como necesito copiar valores de los combobox a celdas, cuando ejecuto el boton de "busqueda rapida" lo primero que hace es pasar todos los valores de la base de datos sobre la celda que indique para copiar en el codigo y obviamente al tener una base de datos muy grande el programa se hace demasiado lento. no se como hacer para optimizar el codigo y si la forma en que lo hice es la indicada.

estoy atento a sus comentarios

copia.zip