Run-time Error 438

Vale1976

New Member
Joined
Jun 1, 2013
Messages
44
I have this code:
VBA Code:
Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Column = 11 Then
        Dim sheet As Worksheet
        Dim IdTest As String
        Dim FoglioNonEsistente As Boolean
        Dim i As Integer
        Application.DisplayAlerts = False
        IdTest = Me.Range("$B$" & Target.Row).Value
        FoglioNonEsistente = True
        For Each sheet In ThisWorkbook.Worksheets
            If sheet.Name = "TEST # " & IdTest Then
                FoglioNonEsistente = False
                Exit For
            End If
        Next
        If IsDate(Target) = False Then
            If CellaSelezionata <> "" And FoglioNonEsistente = False Then
                If MessaggioConferma = 0 Then
                    MessaggioConferma = MsgBox("Sei sicuro di voler eliminare la ''Data pianificazione'' e il foglio relativi al test ''# " & Me.Range("$B$" & Target.Row).Value & "''?", vbQuestion + vbYesNo, "Richiesta conferma")
                End If
                If MessaggioConferma = 2 Then
                    MsgBox "Operazione annullata!", vbInformation, "Operazione annullata"
                    MessaggioConferma = 0
                    Exit Sub
                ElseIf MessaggioConferma = 6 Then
                    MessaggioConferma = 0
                    pwd_TST = "Mod_TST"
                    With Me
                        .Unprotect pwd_TST
                        .Range("$L$" & Target.Row).Value = ""
                        .Range("$M$" & Target.Row).Value = ""
                        .Protect pwd_TST
                    End With
                    With ThisWorkbook
                        .Unprotect pwd_TST
                        .Sheets("TEST # " & IdTest).Delete
                        .Protect pwd_TST
                    End With
                    MsgBox "Operazione completata con successo!", vbInformation, "Operazione completata con successo"
                ElseIf MessaggioConferma = 7 Then
                    MessaggioConferma = 2
                    Application.Undo
                End If
            End If
        Else
            pwd_TST = "Mod_TST"
            If CellaSelezionata = "" And FoglioNonEsistente = True Then
                With ThisWorkbook
                    .Unprotect pwd_TST
                    .Worksheets("Modello Test").Copy After:=.Sheets(.Sheets.Count)
                    With .Sheets("Modello Test (2)")
                        .Tab.Color = RGB(255, 255, 0)
                        .Visible = True
                        .Name = "TEST # " & IdTest
                    End With
                    .Protect pwd_TST
                    Dim ws_NuovoTest As Worksheet
                    Set ws_NuovoTest = ThisWorkbook.Worksheets("TEST # " & IdTest)
                    With ws_NuovoTest
                        .Unprotect pwd_TST
                        .Range("$A$5").Value = "TEST # " & IdTest
                        .Range("$C$7").Value = Me.Range("$C$" & Target.Row).Value
                        .Range("$C$8").Value = Me.Range("$D$" & Target.Row).Value
                        .Range("$C$8:$D$8").Interior.Color = Me.Range("$D$" & Target.Row).DisplayFormat.Interior.Color
                        .Range("$C$9").Value = Me.Range("$E$" & Target.Row).Value
                        .Range("$C$9:$D$9").Interior.Color = Me.Range("$E$" & Target.Row).DisplayFormat.Interior.Color
                        .Range("$C$10").Value = Me.Range("$F$" & Target.Row).Value
                        .Range("$C$10:$D$10").Interior.Color = Me.Range("$F$" & Target.Row).DisplayFormat.Interior.Color
                        Dim RigaMinaccia As Integer
                        RigaMinaccia = 8
                        For i = Target.Row To Target.Row + 9
                            If Me.Range("$G" & i).Value <> "" Then
                                .Range("$E$" & RigaMinaccia).Value = Me.Range("$G" & i).Value
                                With .Range("$I$" & RigaMinaccia)
                                    .Value = Me.Range("$H" & i).Value
                                    .Interior.Color = Me.Range("$H" & i).DisplayFormat.Interior.Color
                                End With
                                RigaMinaccia = RigaMinaccia + 1
                            End If
                        Next i
                        If RigaMinaccia > 10 And RigaMinaccia < 18 Then
                            .Rows(RigaMinaccia & ":17").EntireRow.Hidden = True
                        Else
                            .Rows("11:17").EntireRow.Hidden = True
                        End If
                        .Range("$A$20").Value = Me.Range("$I$" & Target.Row).Value
                        .Range("$C$20").Formula = "=IF('Programma dei test'!$J$" & Target.Row & "="""","""",'Programma dei test'!$J$" & Target.Row & ")"
                        .Range("$E$20").Value = Me.Range("$K$" & Target.Row).Value
                        With Me
                            .Unprotect pwd_TST
                            .Range("$L$" & Target.Row).Formula = "=IF('TEST # " & IdTest & "'!$F$20="""","""",'TEST # " & IdTest & "'!$F$20)"
                            .Range("$M$" & Target.Row).Formula = "=IF('TEST # " & IdTest & "'!$G$20="""","""",'TEST # " & IdTest & "'!$G$20)"
                            .Protect pwd_TST
                        End With
                        Dim wb_STR As Worksheets
                        Set ws_IndSistemiIT = ThisWorkbook.Worksheets("Indisponibilità Sistemi IT")
                        Set ws_IndSedi = ThisWorkbook.Worksheets("Indisponibilità Sedi")
                        Set ws_IndFacility = ThisWorkbook.Worksheets("Indisponibilità Facility")
                        Set ws_IndPersonaleStaff = ThisWorkbook.Worksheets("Indisponibilità Personale-Staff")
                        Set ws_IndAltriAsset = ThisWorkbook.Worksheets("Indisponibilità Altri asset")
                        Select Case Right(Left(IdTest, 6), 2)
                            Case "IT"
                                Set ws_STR = ws_IndSistemiIT
                            Case "SE"
                                Set ws_STR = ws_IndSedi
                            Case "FA"
                                Set ws_STR = ws_IndFacility
                            Case "PS"
                                Set ws_STR = ws_IndPersonaleStaff
                            Case "AA"
                                Set ws_STR = ws_IndAltriAsset
                        End Select
                        If Application.WorksheetFunction.CountIfs(ws_STR.Range("$A:$A"), IdTest, ws_STR.Range("$G:$G"), "X", ws_STR.Range("$O:$O"), "<>") > 0 Then
                            Dim RigaStrategia As Integer
                            RigaStrategia = Application.WorksheetFunction.Match(IdTest, ws_STR.Range("$A:$A"), 0)
                            For i = RigaStrategia To RigaStrategia + 9
                                If ws_STR.Range("$O" & i).Value <> "" Then
                                    .Range("$B$" & .Range("B34").End(xlUp).Row + 1).Value = ws_STR.Range("$O$" & i).Value
                                End If
                            Next i
                        Else
                        End If
                        .Protect pwd_TST
                        If Me.Range("$J$" & Target.Row).Value = "" Then
                            MsgBox "Il campo ''Owner del test'' è vuoto", vbExclamation, "Campo ''Owner del test'' vuoto"
                        End If
                    End With
                End With
                Me.Activate
                If MsgBox("Test pianificato con successo!" & vbNewLine & vbNewLine & "Vuoi attivare il foglio relativo al test ''# " & Me.Range("$B$" & Target.Row).Value & "''?", vbQuestion + vbYesNo, "Test pianificato con successo") = vbYes Then
                    Worksheets("TEST # " & Me.Range("$B$" & Target.Row).Value).Activate
                End If
            ElseIf CellaSelezionata <> "" And FoglioNonEsiste = False Then
                With Worksheets("TEST # " & Me.Range("$B$" & Target.Row).Value)
                    .Unprotect pwd_TST
                    .Range("$E$20").Value = Target.Value
                    .Protect pwd_TST
                End With
                Me.Activate
                If MsgBox("Test ripianificato con successo!" & vbNewLine & vbNewLine & "Vuoi attivare il foglio relativo al test ''# " & Me.Range("$B$" & Target.Row).Value & "''?", vbQuestion + vbYesNo, "Test ripianificato con successo") = vbYes Then
                    Worksheets("TEST # " & Me.Range("$B$" & Target.Row).Value).Activate
                End If
            End If
        End If
        Application.DisplayAlerts = True
    End If
End Sub

How can I fix Run-time Error 438? I'm not able to check the code string that return the error
 

Excel Facts

Select all contiguous cells
Pressing Ctrl+* (asterisk) will select the "current region" - all contiguous cells in all directions.
When the highlighted code is executed, then the message in image is showed
image.png

When I click on "Continua" the debugger stop to work, the elaboration go on and no error is displayed. If I repeat the same change on another cell, every public variable (set on the Workbook_Open() event) is an empty string
 
Upvote 0
I've implemented a workaround.

I set all public variables in a function... and this function is executed both on Workbook_Open() event and on change of each cell. But what happen is very strange!!!
 
Upvote 0

Forum statistics

Threads
1,215,479
Messages
6,125,041
Members
449,206
Latest member
Healthydogs

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