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 <<<
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
Last edited by a moderator: