VBA is a total black magic to me so please be gentle and assume you're talking to an idiot :)
I've created a spreadsheet, with multiple tabs.
Based on a drop down selection, I am trying to move rows to corresponding sheets.
I've achieved that ( and is working great ) by using the below VBA code:
Private Sub Worksheet_Change(ByVal Target As Range)
' Check to see only one cell updated
If Target.CountLarge > 1 Then Exit Sub
' Check to see if entry is made in column C after row 7 and is set to "Yes"
If Target.Column = 3 And Target.Row > 7 And (Target.Value = "LTS" Or Target.Value = "On Hold") Then
Application.EnableEvents = False
' Copy columns A to AU to complete sheet in next available row
Range(Cells(Target.Row, "A"), Cells(Target.Row, "AU")).Copy Sheets("On Hold and LTS").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
' Delete current row after copied
Rows(Target.Row).Delete
Application.EnableEvents = True
End If
' Check to see if entry is made in column C after row 7 and is set to "Yes"
If Target.Column = 3 And Target.Row > 7 And (Target.Value = "Leaver") Then
Application.EnableEvents = False
' Copy columns B to I to complete sheet in next available row
Range(Cells(Target.Row, "A"), Cells(Target.Row, "AU")).Copy Sheets("Leavers").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
' Delete current row after copied
Rows(Target.Row).Delete
Application.EnableEvents = True
End If
End Sub
Although the above code works as intended, every time I receive the "run time error 424 - object required message". Clicking end resolves it and the rule works as intended.
( The second part of the code [ Leaver ] does not produce the error, and also works as intended )
Could you please help me stopping this error from coming up please?
Thank you!
If the cell contains "LTS" (or "On Hold") then the first If..End If block runs and among other things deletes the row containing Target. You then move to your second If..End If block and test Target - which no longer exists - hence your error.
Try using ElseIf in there instead:
Private Sub Worksheet_Change(ByVal Target As Range)
' Check to see only one cell updated
If Target.CountLarge > 1 Then Exit Sub
' Check to see if entry is made in column C after row 7 and is set to "Yes"
If Target.Column = 3 And Target.Row > 7 And (Target.Value = "LTS" Or Target.Value = "On Hold") Then
Application.EnableEvents = False
' Copy columns A to AU to complete sheet in next available row
Range(Cells(Target.Row, "A"), Cells(Target.Row, "AU")).Copy Sheets("On Hold and LTS").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
' Delete current row after copied
Rows(Target.Row).Delete
Application.EnableEvents = True
' Check to see if entry is made in column C after row 7 and is set to "Yes"
ElseIf Target.Column = 3 And Target.Row > 7 And (Target.Value = "Leaver") Then
Application.EnableEvents = False
' Copy columns B to I to complete sheet in next available row
Range(Cells(Target.Row, "A"), Cells(Target.Row, "AU")).Copy Sheets("Leavers").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
' Delete current row after copied
Rows(Target.Row).Delete
Application.EnableEvents = True
End If
End Sub
Related
Have had some great help from this forum on editing my codes. I need to update it just slightly, but can't seem to figure out the right solution. Essentially, my code allows for cell clearing and color in adjacent data validation dropdowns. I have the primary dropdown in column F, secondary dropdown in column G, and final dropdown in column H. My code works as such: if the primary dropdown value in column F changes, clear and color adjacent cells in column G and H. If only secondary dropdown value in column G changes, clear and color adjacent cells in column H.
What I need is if there is a change in primary dropdown in column F, not to clear contents, but only color the cell, while still clearing and coloring adjacent cells in column G and H, or clearing and coloring adjacent cells in column H if change in secondary dropdown in column G.
I tried adjusting the (For i = Target.Column + 1 To 8) to (For i = Target.Column + 0 to 8) and it does work with coloring the primary dropdown, but then it clears it. And I can't make a selection because it is clearing it consistently. Thus, I cannot make any adjacent dropdown selections.
Here is the code I have so far:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim i As Long
If Target.CountLarge <> 1 Then Exit Sub 'screen out multi-cell changes
If Target.Column > 7 Then Exit Sub 'col 1/2
If Not CellHasValidation(Target) Then Exit Sub '...with validation
On Error GoTo haveError 'ensure events are not left off
Application.EnableEvents = False
'loop to max column to be cleared
For i = Target.Column + 1 To 8
With Target.EntireRow.Cells(i)
.Interior.ColorIndex = 44
.Value = ""
End With
Next i
Application.EnableEvents = True
haveError:
MsgBox Err.Description
Application.EnableEvents = True
End Sub
'check if a cell has validation
Function CellHasValidation(cell As Range) As Boolean
Dim vt
On Error Resume Next 'ignore if error (no validation)
vt = cell.Validation.Type
On Error GoTo 0 'stop ignoring errors
CellHasValidation = Not IsEmpty(vt)
End Function
So after a bit of troubleshooting, I was able to embed if statements into the code in order to test for the target column before running the entire row change.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim i As Long
If Target.CountLarge <> 1 Then Exit Sub 'screen out multi-cell changes
If Target.Column > 7 Then Exit Sub 'col 1/2
If Not CellHasValidation(Target) Then Exit Sub '...with validation
On Error GoTo haveError 'ensure events are not left off
Application.EnableEvents = False
'loop to max column to be cleared
If Target.Column = 6 Then
ActiveCell.Interior.ColorIndex = 44
End If
If Target.Column = 7 Then
ActiveCell.Interior.ColorIndex = 44
End If
For i = Target.Column + 1 To 8
With Target.EntireRow.Cells(i)
.Interior.ColorIndex = 44
.Value = ""
End With
Next i
Application.EnableEvents = True
Exit Sub
haveError:
MsgBox Err.Description
Application.EnableEvents = True
End Sub
'check if a cell has validation
Function CellHasValidation(cell As Range) As Boolean
Dim vt
On Error Resume Next 'ignore if error (no validation)
vt = cell.Validation.Type
On Error GoTo 0 'stop ignoring errors
CellHasValidation = Not IsEmpty(vt)
End Function
I haven't found anything specific, so please forgive me if this has been addressed.
I have a spreadsheet set up for the user to scan a barcode (Code128). I need the spreadsheet to automatically place the first 13 digits in the next empty cell in column A, and the remaining characters (10 characters) in the adjacent cell in column B.
I've seen the user of left and right in formulas but haven't determined how to do this in VBA.
Please, copy the next code in the sheet code module where the scanning is done:
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.cells.count > 1 Then Exit Sub
If Target.Column = 1 Then
If Len(Target.Value) > 10 Then
Application.EnableEvents = False
Target.Offset(1).Value = left(Target.Value, 10) 'place first 10 digits in the next cell
Target.Offset(1, 1).Value = Right(Target.Value, Len(Target.Value) - 10) 'and the rest on the next row, column B:B
Target.Offset(2).Select
Application.EnableEvents = True 'select next cell to scan in
End If
End If
End Sub
Before start scanning, if the barcode content is numeric, you should format columns "A:A" and "B:B" as text, but using TextToColumns (one column at a time). Pressing Next, Next, check Text and press Finish.
Edited:
The next version keep the first 10 digits in the cell where the scan has been done, and rest of the digits in column B:B, Target row:
Private Sub Worksheet_Change_(ByVal Target As Range)
If Target.cells.count > 1 Then Exit Sub
If Target.Column = 1 Then
If Len(Target.Value) > 10 Then
Application.EnableEvents = False
Target.Offset(1).Value = left(Target.Value, 10)
Target.Offset(1, 1).Value = Right(Target.Value, Len(Target.Value) - 10)
Target.Offset(2).Select
Application.EnableEvents = True
End If
End If
End Sub
I want to update 2 columns values based on another columns value (if value change). Suppose I have column A with a list (AA1, AA2, AA3), column B with a list (BB1, BB2), column C with a list (CC1, CC2). If a choose a value "AA1" from column A then Column B value should change to BB2 et column C to CC1. But nothing should happen if the value chosen in column A is different from "AA1". The same process occurs also for value "BB1" in column B. I added a vba but it not working. Also is there another way to do it without running a vba code ? Thanks
Private Sub Worksheet_Change(ByVal Target As Range)
Dim changedCells As Range
Set changedCells = Range("A:C")
If Not Application.Intersect(changedCells, Range(Target.Address)) Is Nothing Then
If Target.Count > 1 Then Exit Sub
If Target.Column = 1 And LCase(Target.Value) = "aa1"Then
Cells(Target.Row, 2) = "BB2"
Cells(Target.Row, 3) = "CC1"
ElseIf Target.Column = 2 And LCase(Target.Value) = "bb1" Then
Cells(Target.Row, 1) = "AA3"
Cells(Target.Row, 3) = "CC2"
ElseIf Target.Column = 3 And LCase(Target.Value) = "cc2" Then
Cells(Target.Row, 1) = "AA2"
Cells(Target.Row, 2) = "BB2"
End If
End If
End Sub
Your code is broadly OK, except it will cause an Event Cascade (changing a cell triggers the Worksheet_Change event, which changes a cell, which triggers Worksheet_Change, which ...)
You need to add Application.EnableEvents = False to prevent this (add ... = True at the end)
Here's your code refactored to address this, and a few other minor issues
Private Sub Worksheet_Change(ByVal Target As Range)
Dim changedCells As Range
On Error GoTo EH '~~ ensure EnableEvents is turned back on if an error occurs
Set changedCells = Me.Range("A:C") '~~ explicitly refer to the correct sheet
If Target.Count > 1 Then Exit Sub '~~ do this first, to speed things up
If Not Application.Intersect(changedCells, Target) Is Nothing Then '~~ Target is already a range
Application.EnableEvents = False '~~ prevent an event cascade
'~~ original If Then Else works fine. But can be simplified
Select Case LCase(Target.Value)
Case "aa1"
If Target.Column = 1 Then
Me.Cells(Target.Row, 2) = "BB2"
Me.Cells(Target.Row, 3) = "CC1"
End If
Case "bb1"
If Target.Column = 2 Then
Me.Cells(Target.Row, 1) = "AA3"
Me.Cells(Target.Row, 3) = "CC2"
End If
Case "cc2"
If Target.Column = 3 Then
Me.Cells(Target.Row, 1) = "AA2"
Me.Cells(Target.Row, 2) = "BB2"
End If
End Select
End If
'~~ Fall through to EnableEvents
EH:
Application.EnableEvents = True '~~ ensure EnableEvents is turned back on
End Sub
I am using a macro to write a datestamp when a column is modified. The idea is that whenever the status changes it gives the running time for that particular status. I have four columns:
A b c d
clearing 24.04.2015 1 empty
**when stauts is changed**
A b c d
wait for start 24.04.2015 2 24.04.2015
formual for c is :
IF(RC[-2]="";"";IF(RC[-2]="clearing";1;2))
Macro;
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 1 And Target.Value = "clearing"
Then
Cells(Target.Row, 2) = Date
Else
If Target.Column = 3 And Target.Value = 2
Then
Cells(Target.Row, 4) = Date
End If
End If
End Sub
The problem is when C column is, with the help of formula, changed to 2 the macro does not automatically give me the date, but when I insert that manually it's working.
When you put values into the worksheet that is triggering the Worksheet_Change event macro, you should always turn off events or the macro will try to run on top of itself.
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Columns(1)) Is Nothing Then
On Error GoTo Fìn
Application.EnableEvents = False
Dim rng As Range
For Each rng In Intersect(Target, Columns(1))
If LCase(rng.Value) = "clearing" Then
Cells(rng.Row, 2) = Now
Cells(rng.Row, 2).NumberFormat = "dd.mm.yyyy"
'Cells(rng.Row, 3).FormulaR1C1 = "maybe put the formula in here"
ElseIf rng.Offset(0, 2).Value = 2 Then
Cells(rng.Row, 4) = Now
Cells(rng.Row, 4).NumberFormat = "dd.mm.yyyy"
End If
Next rng
End If
Fìn:
Application.EnableEvents = True
End Sub
It sounds like you already have that formula in column C but I left a place where you can put it in once column A gets the clearing value. Another option would be to simply write a 1 into column C and the next time write a 2 in column C. That way you wouldn't have to deal with the formula at all.
I am currently trying to add a script into excel. excuse my terminology, I am not that hot with programming!
I do all of my accounting on excel 2003, and I would like to be able to add the value of say cells f6 to f27 to the cells e6 to e27, respectively. The thing is, I want the value of the "f" column to reset every time.
So far I have found this code, which works if I copy and paste it into VBA. but it only allows me to use it on one row:
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
If Target.Address = Range("f7").Address Then
Range("e7") = Range("e7") + Range("f7")
Range("f7").ClearContents
End If
Application.EnableEvents = True
End Sub
would somebody be kind enough to explain how I can edit this to do the same through all of my desired cells? I have tried adding Range("f7",[f8],[f9] etc.. but i am really beyond my knowledge.
First, you need to define the range which is supposed to be "caught"; that is, define the range you want to track for changes. I found an example here. Then, simply add the values to the other cell:
Private Sub Worksheet_Change(ByVal Target as Range)
Dim r as Range ' The range you'll track for changes
Set r = Range("F2:F27")
' If the changed cell is not in the tracked range, then exit the procedure
' (in other words, if the intersection between target and r is empty)
If Intersect(Target, r) Is Nothing Then
Exit Sub
Else
' Now, if the changed cell is in the range, then update the required value:
Cells(Target.Row, 5).Value = Cells(Target.Row, 5).Value + Target.Value
' ----------------^
' Column 5 =
' column "E"
' Clear the changed cell
Target.ClearContents
End if
End Sub
Hope this helps
Try this
Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo ErrHandler
Application.ScreenUpdating = False
Application.EnableEvents = False
If Intersect(Target, Range("B1:B5,F6:F27")) Then 'U can define any other range
Target.Offset(0, -1) = Target.Offset(0, -1).Value + Target.Value ' Target.Offset(0,-1) refer to cell one column before the changed cell column.
'OR: Cells(Target.row, 5) = Cells(Target.row, 5).Value + Target.Value ' Where the 5 refer to column E
Target.ClearContents
End If
ErrHandler:
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub