Sign in
 
Home20132010Other VersionsLibraryForumsGallery
TechCenter >
> 
> 
Excel code working in every cell, why?

Answered Excel code working in every cell, why?

  • Friday, May 18, 2012 7:58 PM
     
     
    Sign In to Vote
    0

    I only want to list multiple items in Column F but this lists multiple items in every cell, even when I try to erase the cell.  There is no drop down list in Column H. Please see the image for details.  The code is below the image.

    :

     Private Sub Worksheet_Change(ByVal Target As Range)
        If InWork Then Exit Sub
        InWork = True
        On Error GoTo NonValidatedCell
        If Selection.Validation.Type = xlValidateList Then
            ColAbs = Target.Column
            RowAbs = Target.Row
            If Sheets("IMPACT").Cells(RowAbs, ColAbs).Value = "." Then
                TotalString = ""
            Else
                Application.Undo
                TotalString = Sheets("IMPACT").Cells(RowAbs, ColAbs).Value & ", "
                Application.Undo
                TotalString = TotalString & Sheets("IMPACT").Cells(RowAbs, ColAbs).Value
            End If
            If Left(TotalString, 1) = "," Then TotalString = Mid(TotalString, 3)
            Sheets("IMPACT").Cells(RowAbs, ColAbs).Value = TotalString
            'Sheets("Sheet2").Cells(RowAbs, ColAbs).Value = TotalString
        End If
        InWork = False

        Exit Sub
    NonValidatedCell:
        InWork = False
    End Sub
     

All Replies

  • Friday, May 18, 2012 8:51 PM
     
      Has Code
    Sign In to Vote
    0

    You could add a check:

    Private Sub Worksheet_Change(ByVal Target As Range)
    If InWork Then Exit Sub
    If Target.Count > 1 Then Exit Sub
    If Intersect(Range("F:F"), Target) Is Nothing Then Exit Sub
    InWork = True
    On Error GoTo NonValidatedCell
    If Selection.Validation.Type = xlValidateList Then
        ColAbs = Target.Column
        RowAbs = Target.Row
        If Cells(RowAbs, ColAbs).Value = "." Then
            TotalString = ""
        Else
            Application.Undo
            TotalString = Cells(RowAbs, ColAbs).Value & ", "
            Application.Undo
            TotalString = TotalString & Cells(RowAbs, ColAbs).Value
        End If
        If Left(TotalString, 1) = "," Then TotalString = Mid(TotalString, 3)
        Cells(RowAbs, ColAbs).Value = TotalString
    End If
NonValidatedCell:
    InWork = False
End Sub

    Regards, Hans Vogelaar

     
  • Monday, May 21, 2012 12:34 PM
     
     
    Sign In to Vote
    0
    That code completely crashes Excel.
     
  • Monday, May 21, 2012 1:06 PM
     
     
    Sign In to Vote
    1

    You should turn events off before changing a cell within the change event:

    Private Sub Worksheet_Change(ByVal Target As Range)
        If Target.Cells.Count > 1 Then Exit Sub
        If Target.Column <> 6 Then Exit Sub

        Application.EnableEvents = False
        On Error GoTo NonValidatedCell
        If Target.Validation.Type = xlValidateList Then
            ColAbs = Target.Column
            RowAbs = Target.Row
            If Sheets("IMPACT").Cells(RowAbs, ColAbs).Value = "." Then
                TotalString = ""
            Else
                Application.Undo
                TotalString = Sheets("IMPACT").Cells(RowAbs, ColAbs).Value & ", "
                Application.Undo
                TotalString = TotalString & Sheets("IMPACT").Cells(RowAbs, ColAbs).Value
            End If
            If Left(TotalString, 1) = "," Then TotalString = Mid(TotalString, 3)
            Sheets("IMPACT").Cells(RowAbs, ColAbs).Value = TotalString
            'Sheets("Sheet2").Cells(RowAbs, ColAbs).Value = TotalString
        End If

    NonValidatedCell:
        Application.EnableEvents = True
    End Sub

    HTH, Bernie

     
  • Monday, May 21, 2012 1:15 PM
     
     
    Sign In to Vote
    0
    That code works much better but when I try to delete data from column F, it adds a "comma" rather than deleting the information.
     
  • Monday, May 21, 2012 1:25 PM
     
     Answered
    Sign In to Vote
    1

    I was trusting that the functionality of your code was what you wanted.

    Anyway, just add one line to your checks:

    Private Sub Worksheet_Change(ByVal Target As Range)
        If Target.Cells.Count > 1 Then Exit Sub
        If Target.Column <> 6 Then Exit Sub
        If Target.Value = "" Then Exit Sub

    HTH, Bernie