An IF function checks whether the cells in any of the rows in the chosen column of the table is filled in, e.g. Column 1, row 1, 2 and 3 - if any of the cells is filled in - additional rows are unhidden.
The function works when the table is getting filled in but only until something gets deleted from it.
e.g. if the table has all the rows 1, 2 and 3 in column 1 filled in - additional rows appear. If I delete one of the cells values e.g. column 1 row 1 - the additional row hides again. The criteria for it to be unhidden is still there, rows 2 and 3 are still filled in.
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 2 And Target.Row = 90 Then
If Target.Value = "" Then
Application.Rows("94:101").Select
Application.Selection.EntireRow.Hidden = True
Else: [94:101].EntireRow.Hidden = False
End If
End If
If Target.Column = 2 And Target.Row = 91 Then
If Target.Value = "" Then
Application.Rows("94:101").Select
Application.Selection.EntireRow.Hidden = True
Else: [94:101].EntireRow.Hidden = False
End If
End If
If Target.Column = 2 And Target.Row = 92 Then
If Target.Value = "" Then
Application.Rows("94:101").Select
Application.Selection.EntireRow.Hidden = True
Else: [94:101].EntireRow.Hidden = False
End If
End If
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Row = 2 And (Target.Column = 90 Or Target.Column = 91 Or Target.Column = 92) Then
If Range("B90") = "" And Range("B91") = "" And Range("B92") = "" Then
Range("A94:A101").EntireRow.Hidden = True
Else
Range("A94:A101").EntireRow.Hidden = False
End If
End If
End Sub
Check #PEH comment first.
Following your philosophy, try this one:
Private Sub Worksheet_Change(ByVal Target As Range)
With WorkSheets(1)
If (.Range("B90").Value2 <> "") Or (.Range("B91").Value2 <> "") Or _
(.Range("B92").Value2 <> "") Then
If Target.Value = "" Then
.Rows("94:101").EntireRow.Hidden = True
Else
.Rows("94:101").EntireRow.Hidden = False
End If
End If
End With
End Sub
Just custom the WorkSheets(1) to your WorkBook.
Related
I have a macro:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim v
If Target.Cells.Count <> 1 Then Exit Sub
If Target.Column <> 1 Then Exit Sub
v = Target.Value
If VarType(v) <> vbDate Then
Application.EnableEvents = False
If v Like "???##" Or v Like "???-##" Then Target.Value = Left(v, Len(v) - 2) & "20" & Right(v, 2)
If VarType(Target.Value) <> vbDate Then Target.Value = Empty
Target.NumberFormat = "m/d/yyyy"
Application.EnableEvents = True
End If
End Sub
When copying (ex: may20, may-20) from another column to column A in Excel itself with this macro, it allows to paste only once - the next cell is no longer pasted, apparently, the clipboard is cleared after the first paste. I have to copy again from another column. How it can be corrected?
See below - if you need to paste the same value again.
The core problem is that the change event always clears the clipboard - there's no (easy) way I'm aware of to prevent that.
Private Sub Worksheet_Change(ByVal Target As Range)
Const MNTH_NM As String = "[A-Z][A-Z][A-Z]" 'a bit better than "???"
Dim v
If Target.Cells.Count <> 1 Then Exit Sub
If Target.Column <> 1 Then Exit Sub
v = Target.Value
If Len(v) > 0 Then
Application.EnableEvents = False
If UCase(v) Like MNTH_NM & "##" Or UCase(v) Like MNTH_NM & "-##" Then
v = Left(v, 3) & "-20" & Right(v, 2)
Target.NumberFormat = "m/d/yyyy"
Target.Value = v
Target.Copy
Else
Target.ClearContents 'if doesn't match the pattern, clear it
End If
Application.EnableEvents = True
End If 'non-zero length
End Sub
I have 2 sheets in same workbook, one is data sheet and 2nd sheet contains the data validation values. I am facing problem while removing value from a cell (in data sheet) (which contains data validation). The issue is when I try to remove the value from validation list, the same value didn't remove from the cell. (see screen shot)
"e.g. if I want to remove volunteer name from the validation list, the value didn't delete from cell in data sheet (cell highlighted in screenshot)."
I have written a vba code to add multiple values in same cell separated by commas. I would appreciate if someone help me to solve this issue.
My VBA code is below:
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rngDV As Range
Dim oldVal As String
Dim newVal As String
Dim lUsed As Long
If Target.Count > 1 Then GoTo exitHandler
On Error Resume Next
Set rngDV = Cells.SpecialCells(xlCellTypeAllValidation)
On Error GoTo exitHandler
If rngDV Is Nothing Then GoTo exitHandler
If Intersect(Target, rngDV) Is Nothing Then
'do nothing
Else
Application.EnableEvents = False
newVal = Target.Value
Application.Undo
oldVal = Target.Value
Target.Value = newVal
If Target.Column = 3 Or Target.Column = 4 Or Target.Column = 5 Or Target.Column = 6 Or
Target.Column = 7 Or Target.Column = 8 _
Or Target.Column = 9 Or Target.Column = 11 Then
If oldVal = "" Then
'do nothing
Else
If newVal = "" Then
'do nothing
Else
lUsed = InStr(1, oldVal, newVal)
If lUsed > 0 Then
If Right(oldVal, Len(newVal)) = newVal Then
Target.Value = Left(oldVal, Len(oldVal) - Len(newVal) - 2)
Else
Target.Value = Replace(oldVal, newVal & ", ", "")
End If
Else
Target.Value = oldVal _
& ", " & newVal
End If
End If
End If
End If
End If
exitHandler:
Application.EnableEvents = True
End Sub
You can find the worksheet from the link below: (show1 Sheet is data sheet and Validation Fields contains the drop-down values)
Excel Sheet
Thanks
This code works for me:
Private Sub Worksheet_Change(ByVal Target As Range)
Const SEP As String = ","
Dim c As Range, NewValue As String, OldValue As String, arr, v, lst, removed As Boolean
On Error GoTo Exitsub
If Target.CountLarge > 1 Then Exit Sub '<< only handling single-cell changes
Select Case Target.Column
Case 3, 4, 5, 6, 7, 8, 9, 11
Set c = Target
Case Else: Exit Sub
End Select
If Len(c.Value) > 0 And Not c.Validation Is Nothing Then
Application.EnableEvents = False
NewValue = c.Value
Application.Undo
OldValue = c.Value
If OldValue = "" Then
c.Value = NewValue
Else
arr = Split(OldValue, SEP)
'loop over previous list, removing newvalue if found
For Each v In arr
If Trim(CStr(v)) = NewValue Then
removed = True
Else
lst = lst & IIf(lst = "", "", SEP) & v
End If
Next v
'add the new value if we didn't just remove it
If Not removed Then lst = lst & IIf(lst = "", "", SEP) & NewValue
c.Value = lst
End If
End If 'has validation and non-empty
Exitsub:
If Err.Number <> 0 Then MsgBox Err.Description
Application.EnableEvents = True
End Sub
Want sequence to start on Cell A4. so that A4 is 1, A5 is 2 et al to A1004 = 1004
Tried changing [Range("A" & I)..] to [Range("A4" & I)..]
Tried changing I=4
Private Sub Worksheet_Change(ByVal Target As Range)
Dim I As Integer
I = 1
Application.EnableEvents = False
For I = 1 To 1000
Range("A" & I).Value = I
Next
Range("A1010").Value = ""
Application.EnableEvents = True
End Sub
Sub Worksheet_Change(ByVal Target As Range)
Dim I As Integer
Set startRng = Cells(4, 1)
Application.EnableEvents = False
For I = 0 To 999
startRng.Offset(I, 0) = I
Next
Range("A1010").Value = ""
Application.EnableEvents = True
End Sub
I add a date picker 12.0 on Sheet 1 and would like to have it working across sheet 2 and sheet 3 as well.
The below code only works on column 3 and column 6 of sheet 1, but when I click on the column 3 and column 6 in sheet 2 or sheet 3, no date picker shows up.
Please help, thanks a bunch!
Private Sub Calendar1_Click()
Selection.Value = Calendar1.Value
Calendar1.Visible = False
Calendar1.Value = Date
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Column <> 3 And Target.Column <> 6 Then Calendar1.Visible = fales: Exit Sub
Calendar1.Top = (Target.Row - 1) * 16.5
Calendar1.Top = ActiveCell.Top
Calendar1.Left = ActiveCell.Left + 80
Calendar1.Visible = True
End Sub
Assuming Calendar1 is available to the other worksheets then include your event trigger in the Workbook_SheetSelectionChange as below:
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
If Target.Column <> 3 And Target.Column <> 6 Then Calendar1.Visible = False: Exit Sub
Calendar1.Top = (Target.Row - 1) * 16.5
Calendar1.Top = Target.Top
Calendar1.Left = Target.Left + 80
Calendar1.Visible = True
End Sub
Regards,
Place this code in Workbook Module
Option Explicit
Private Sub Calendar1_Click()
Selection.Value = Calendar1.Value
Calendar1.Visible = False
Calendar1.Value = Date
End Sub
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
If Target.Column <> 3 And Target.Column <> 6 Then
Calendar1.Visible = False
Exit Sub
Else
Calendar1.Top = (Target.Row - 1) * 16.5
Calendar1.Top = ActiveCell.Top
Calendar1.Left = ActiveCell.Left + 80
Calendar1.Visible = True
End If
End Sub
I have to create a cell like and I am looking a way to do it with excel formulas or VBA code.
With two differents formts red to green or just black, but not in all the case depends If.
For example:
Case 1: If cell F1 and G1 has values the format is Red to green
Case 2: If cell F1 has a value but G is empty the final format in image 1 have to be Just black
This VBA code should work. It goes into the worksheet_change event of your sheet.
I just set it for column I to change colors, but you can extend to J and K if you need to.
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
With Application
.EnableEvents = False
.ScreenUpdating = False
End With
If Target.Column = 6 Or Target.Column = 7 Then
Select Case Target.Column
Case Is = 6
If Target <> vbNullString And Target.Offset(, 1) <> vbNullString Then
With Target.Offset(, 2)
.Characters(Start:=1, Length:=5).Font.ColorIndex = 3
.Characters(Start:=6, Length:=3).Font.ColorIndex = 4
End With
Else: Target.Offset(, 2).Font.ColorIndex = 0
End If
Case Is = 7
If Target <> vbNullString And Target.Offset(, -1) <> vbNullString Then
With Target.Offset(, 1)
.Characters(Start:=1, Length:=5).Font.ColorIndex = 3
.Characters(Start:=6, Length:=3).Font.ColorIndex = 4
End With
Else: Target.Offset(, 1).Font.ColorIndex = 0
End If
End Select
End If
With Application
.EnableEvents = True
.ScreenUpdating = True
End With
End Sub