• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

VBA Error

Foxtrots

New Member
Hi Excel experts,

I have a Worksheet_Change code in a work sheet that checks if the range in the table (10 columns of data) on the sheet has changed, if so, I need it to trigger two macros, one macro to delete blanks rows if there are 2 or more blanks in any row of the table and the second macro to select the current cell and then complete some validation and input formulas into certain columns and conditional format certain cells of the row then return to the original selected cell in the sheet.

i have the 3 codes in the workbook sheet but every time I activate the SheetValidation macro, excel shuts down. Any help in updating the macros would be appreciated. I have attached a sample file. The 'Call SheetValidation is deactivated in the macro in the sample file.


>>> use code - tags <<<
Code:
Private Sub Worksheet_Change(ByVal Target As Range)

Application.ScreenUpdating = False
 
    If Not Intersect(Target, Range("Table1")) Is Nothing Then

    Call DeleteBlankRows

    'Call SheetValidation

    End If

Application.ScreenUpdating = True

End Sub


Private Sub DeleteBlankRows()

    Dim SourceRange As Range
    Dim EntireRow As Range
    Dim i As Integer

    Set SourceRange = ActiveSheet.Range("Table1")

    If Not (SourceRange Is Nothing) Then
        Application.ScreenUpdating = False

        For i = SourceRange.Rows.Count To 1 Step -1
            Set EntireRow = SourceRange.Cells(i, 1).EntireRow
            If Application.WorksheetFunction.CountA(EntireRow) = 1 Then
                EntireRow.Delete
            End If

        Next

        Application.ScreenUpdating = True
  
    End If

End Sub


Private Sub SheetValidation()

Application.ScreenUpdating = False
  
    Dim c As Range
    Set c = ActiveCell
  
    Application.GoTo Reference:="Table1"
    Range("Table1[Valid]").Select
    With Selection.Validation
        .Delete
        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
        xlBetween, Formula1:="Yes, No, N/A"
        .IgnoreBlank = True
        .InCellDropdown = True
        .InputTitle = ""
        .ErrorTitle = ""
        .InputMessage = ""
        .ErrorMessage = "Select a option from the drop down list"
        .ShowInput = True
        .ShowError = True
    End With

    Sheets("Sheet1").ListObjects("Table1").ListColumns("Place").DataBodyRange.ClearFormats
    Sheets("Sheet1").ListObjects("Table1").ListColumns("Place").DataBodyRange.Formula = "=IF([@[Name]]="""","""",""London"")"
    Sheets("Sheet1").ListObjects("Table1").ListColumns("Date").DataBodyRange.Locked = Place

    Cells.FormatConditions.Delete
    Range("Table1[Date]").Select
    Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
    "=OR(A3="""",B3="""",E3="""",F3="""",G3="""",H3="""",I3="""",J3="""",K3="""",L3="""")"
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
    With Selection.FormatConditions(1).Interior
        .PatternColorIndex = xlAutomatic
        .Color = 255
        .TintAndShade = 0
    End With

    ListObjects("Table1").DataBodyRange.Select
    With Selection
    .HorizontalAlignment = xlLeft
    .VerticalAlignment = xlTop
    .WrapText = True
    End With

c.Select

Application.ScreenUpdating = True

End Sub
 

Attachments

  • Book1.xlsm
    16.3 KB · Views: 3
Last edited by a moderator:
You are changing cells within a change event, which will call the same event code recursively. You need to disable events while making the changes - e.g.

Code:
Private Sub Worksheet_Change(ByVal Target As Range)

Application.ScreenUpdating = False

If Not Intersect(Target, Range("Table1")) Is Nothing Then
application.enableevents = false
Call DeleteBlankRows

Call SheetValidation

application.enableevents = true
End If

Application.ScreenUpdating = True

End Sub
 
Hi Debaser,

Thank you so much, works like a charm

spent much time trying to figure out what i was doing wrong.

Thanks again, much appreciate your assistance.
 
Back
Top