I'm not experienced in VBA and I've pieced together a small script to make the contents of a cell uppercase once any value has been entered. The script should apply this only to a certain range of cells, in my case J11:AK25.
The script works (it makes the contents of a cell uppercase once something is entered or changed), but Excel crashes right after entering or changing a value. This happens in Excel 2013.
The code I have right now:
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Me.Range("J11:AK24")) Is Nothing Then RunUp
End Sub
Sub RunUp()
Range("J11:AK25") = [index(upper(J11:AK25),)]
End Sub
Anyone able to assist?
turn off the events before calling the other sub:
Private Sub Worksheet_Change(ByVal Target As Range)
On Error Goto SafeOut
Application.EnableEvents = False
If Not Intersect(Target, Me.Range("J11:AK24")) Is Nothing Then RunUp
SafeOut:
Application.EnableEvents = True
End Sub
That being said, this may be safer:
Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo SafeOut
Application.EnableEvents = False
Dim rng As Range
Set rng = Intersect(Target, Me.Range("J11:AK24"))
If Not rng Is Nothing Then
Dim cel As Range
For Each cel In rng
cel.Value = UCase$(cel.Value)
Next cel
End If
SafeOut:
Application.EnableEvents = True
End Sub
Related
I would like to move to the next line by offsetting from ActiveCell, but it either doesn't work or I get run time error. Maybe this isn't possible within Private Sub Worksheet_Change(ByVal Target As Range), but sure would be nicer for users of this free workbook.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng As Range
Set rng = Range("C4:C400")
If Not Intersect(Target, rng) Is Nothing Then
ActiveWorkbook.Save
Set selectedCell = Application.ActiveCell
ActiveCell.Offset(1, -4).Select
End If
Dim cng As Range
Set cng = Range("A4:A400")
If Not Intersect(Target, cng) Is Nothing Then
Application.EnableEvents = False
Target.Value = WorksheetFunction.Proper(Target.Value)
Application.EnableEvents = True
End If
End Sub
I have a problem with VBA, I need to use the worksheet change event to pickup cell values from AI28 to AI30 and move them over to V28 to V30. This is what I have do so far
Private Sub Worksheet_Change(ByVal Target As Range)
If IsNumeric(Target) And Not (Target = "") Then
If Target.Address = Range("AI28:AI30").Address Then
Range("V28:V30").Value = Range("AH28:AH30").Value
Else
If Target.Cells.Value <> Empty Then Exit Sub
Exit Sub
End If
End If
End Sub
It works fine for just one range eg AI28 and V28 so what am I missing? A loop or something?
Use a loop and Intersect:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng As Range
Set rng = Intersect(Target, Me.Range("AI28:AI30"))
If rng Is Nothing Then Exit Sub
On Error GoTo SafeExit
Application.EnableEvents = False
Dim cell As Range
For Each cell In rng
If IsNumeric(cell.Value) And Not IsEmpty(cell.Value) Then
Me.Range("V" & cell.Row).Value = cell.Value
End If
Next
SafeExit:
Application.EnableEvents = True
End Sub
I want to record a list of live data in a separate sheet.
Found this code online which works.
How to do I change the range from one cell A1 to a Range A1:D30?
Private Sub Worksheet_Change(ByVal Target As Range)
Dim dest As Range
Application.EnableAnimations = False
On Error GoTo line1
If Target.Address <> "$A$1" Then GoTo line1
Set dest = Worksheets("sheet2").Cells(Rows.Count, "a").End(xlUp).Offset(1, 0)
'MsgBox dest.Address
Target.Copy dest
line1:
Application.EnableEvents = True
End Sub
This can be done without a custom function. VBA already contains all you need.
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("A1:D30")) Is Nothing Then
' run some code
End If
End Sub
I want to merge two Worksheet_Change events.
The aim of the code is to convert any uppercase text in the cell ranges given to lowercase.
I tried copying both into the same Worksheet_Change, but Excel crashed.
Range 1:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim ccr As Range
Set ccr = Range("C6")
For Each Cell In ccr
Cell.Value = LCase(Cell)
Next Cell
End Sub
Range 2:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim acr As Range
Set acr = Range("C9:G9")
For Each Cell In acr
Cell.Value = LCase(Cell)
Next Cell
End Sub
The main issue is that changing a cell value Cell.Value will trigger another Worksheet_Change immediately. You need to Application.EnableEvents = False to prevent this.
Also I recommend to work with Intersect so the code only runs on the cells that are actually changed.
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim AffectedRange As Range
Set AffectedRange = Intersect(Target, Target.Parent.Range("C6, C9:G9"))
If Not AffectedRange Is Nothing Then
Application.EnableEvents = False 'pervent triggering another change event
Dim Cel As Range
For Each Cel In AffectedRange.Cells
Cel.Value = LCase$(Cel.Value)
Next Cel
Application.EnableEvents = True 'don't forget to re-enable events in the end
End If
End Sub
In addition to #Frank Ball's comment including error handling:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim AffectedRange As Range
Set AffectedRange = Intersect(Target, Target.Parent.Range("C6, C9:G9"))
Application.EnableEvents = False 'pervent triggering another change event
On Error GoTo ERR_HANDLING
If Not AffectedRange Is Nothing Then
Dim Cel As Range
For Each Cel In AffectedRange.Cells
Cel.Value = LCase$(Cel.Value)
Next Cel
End If
On Error GoTo 0
'no Exit Sub here!
ERR_HANDLING:
Application.EnableEvents = True
If Err.Number <> 0 Then
Err.Raise Err.Number, Err.Source, Err.Description, Err.HelpFile, Err.HelpContext
End If
End Sub
Like this you can do both the things in same event
You have to add Application.EnableEvents = False at the starting to avoid race condition.
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
Dim ccr As Range, acr as Range
Set ccr = Range("C6")
For Each Cell In ccr
Cell.Value = LCase(Cell)
Next Cell
Set acr = Range("C9:G9")
For Each Cell In acr
Cell.Value = LCase(Cell)
Next Cell
Application.EnableEvents = True
End Sub
The two Worksheet_Change events are quite the same, they are a loop around a range, returning LCase(). Thus, it is a good idea to make a separate Sub for it like this:
Sub FixRangeLCase(rangeToFix As Range)
Dim myCell As Range
For Each myCell In rangeToFix
myCell.Value2 = LCase(myCell.Value2)
Next myCell
End Sub
Then, refer the Worksheet_Change event to it. As far as the Worksheet_Change event is quite "expensive", running always, it is a good idea to run it only when a specific Target cell is changed and otherwise exit the procedure - If Intersect(Target, Range("C6"), Range("C9:G9")) Is Nothing Then Exit Sub
The Application.EnableEvents = False is needed to disable the events. At the end it is set back to True.
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("C6"), Range("C9:G9")) Is Nothing Then Exit Sub
Application.EnableEvents = False
FixRangeLCase Range("C6")
FixRangeLCase Range("C9:G9")
Application.EnableEvents = True
End Sub
Also you can use:
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng As Range, cell As Range
Application.EnableEvents = False
If Not Intersect(Target, Range("C6")) Is Nothing Or Not Intersect(Target, Range("C9:G9")) Is Nothing Then
Set rng = Range("C9:G9", "C6")
For Each cell In rng
cell.Value = LCase(cell.Value)
Next
End If
Application.EnableEvents = True
End Sub
The code below is causing an error when I paste information onto the sheet.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim A1 As Range
Set A1 = Range("A:I")
If Not Intersect(Target, A1) Is Nothing Then
Application.EnableEvents = False
Target.Value = UCase(Target.Value)
Application.EnableEvents = True
End If
End Sub
The code is specific to the sheet (right click on tab an view code).
Could you please advise on how to fix this?
Thanks in advance.
Loop over the intersection cells if they exists:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim A1 As Range, intr As Range, r As Range
Set A1 = Range("A:I")
Set intr = Intersect(A1, Target)
If Not intr Is Nothing Then
Application.EnableEvents = False
For Each r In intr
r.Value = UCase(r.Value)
Next r
Application.EnableEvents = True
End If
End Sub
The error is because of Target.Value = UCase(Target.Value) is not suitable for multiple cells. Thus a loop is needed:
Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo WorksheetChange_Error
Application.EnableEvents = False
Dim A1 As Range
Set A1 = Range("A:I")
If Not Intersect(Target, A1) Is Nothing Then
Dim myCell As Range
For Each myCell In Target.Cells
myCell = UCase(myCell)
Next
End If
Application.EnableEvents = True
Exit Sub
WorksheetChange_Error:
Application.EnableEvents = True
MsgBox Err.Description
End Sub
The error handler is used to reset the EnableEvents = True, if some kind of unexpected error comes.