I have a table with data from A5:S and would like to sort by a column with "segment" in headline every time a line is inserted.
I have made a numeric column to the left of my string column "segment" which matches my "ranking", the only issue is that it doesn't sort the rows automatically.
I have tried this VBA, but nothing happen:
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 2 Then
Dim lastRow As Long
lastRow = Cells(Rows.Count, 1).End(xlUp).Row
Range("A5:S" & lastRow).Sort key1:=Range("A5:A" & lastRow), order1:=xlAscending, Header:=xlGuess
End If
End Sub
If you keep a count of the #of rows in Column A, then when you insert a row, the worksheet_change event can run when the rows increase.
Possible adding enableevents to false would be a good idea so the change_evnt does not kick in when sorting
Dim LstRw As Long
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Rws As Long
Rws = Me.Cells(Me.Rows.Count, "A").End(xlUp).Row
If Rws > LstRw Then
Application.EnableEvents = False
MsgBox "Run your code here!"
Application.EnableEvents = True
End If
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
LstRw = Me.Cells(Me.Rows.Count, "A").End(xlUp).Row
End Sub
What about if you change:
if target.column = 2 then
for
if activecell.column = 2 then
Related
The final goal includes having a table on Sheet1 and when certain criteria is met in the last column of the table, the row is copied to Sheet2 and contents are cleared from that row in Sheet1. What I have now works, and accurately copies and clears the data, but it copies past the last column of the table. Is there a function I can add to limit the number of columns copied? I only want columns A to I copied to the second sheet and then cleared from the first.
This is what I have currently. The reason I want to limit the columns copied and cleared is because I want to have another table next to it.
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 9 Then
Application.EnableEvents = False
Dim r As Long
r = Target.Row
Dim Lastrow As Long
Lastrow = Sheets("Tasks").Cells(Rows.Count, "I").End(xlUp).Row + 1
If Target.Value = "Complete" Then
Rows(r).Copy Sheets("Complete Tasks").Cells(Lastrow, 1)
Rows(r).ClearContents
End If
End If
Application.EnableEvents = True
End Sub
It's very simple you have to define a new range without the last column for the row.
Your code may be like this:
(Cell2Copy is the new range to copy )
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Cell2Copy as Range
Dim r As Long
Dim Lastrow As Long
If Target.Column = 9 Then
Application.EnableEvents = False
r = Target.Row
Lastrow = Sheets("Tasks").Cells(Rows.Count, "I").End(xlUp).Row + 1
If Target.Value = "Complete" Then
set Cell2Copy = Rows(r).Cells(1,Columns.count-1)
Cell2Copy.Copy Sheets("Complete Tasks").Cells(Lastrow, 1)
Rows(r).ClearContents
End If
End If
Application.EnableEvents = True
End Sub
Have a good day.
I am using the code below to run a macro Calendar_Advanced if any cell is selected in column M.
Problem: If I select any cell in the same time with Range M:M , the event also fires, like if I selected all row.
Private Sub worksheet_SelectionChange(ByVal Target As Excel.Range)
Dim LastRow As Long: LastRow = ActiveSheet.Cells(Rows.Count, "B").End(xlUp).Row
If Not Intersect(Target, Range("M3:M" & LastRow)) Is Nothing Then
Call Calendar_Advanced
End If
End Sub
I tried to add to the If condition And Selection.Cells.Count = 1.
It works, but prevents multi selection (Calendar_Advanced) to run on column M.
Count the columns to make sure it is just M.
Private Sub worksheet_SelectionChange(ByVal Target As Excel.Range)
Dim LastRow As Long: LastRow = ActiveSheet.Cells(Rows.Count, "B").End(xlUp).Row
If Not Intersect(Target, Range("M3:M" & LastRow)) Is Nothing Then
If Target.Columns.Count = 1 Then
Calendar_Advanced
End If
End If
End Sub
I have been using a sheet where i have created a manual drop down through "Data Validation" and was using this below code to filter the Column.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim lastrow As Long
lastrow = Cells(Rows.Count, "I").End(xlUp).Row
With Me
If Not Intersect(Target, .Range("I13")) Is Nothing Then
If Target.Value <> "" Then
.AutoFilterMode = False
.Range("I15:I" & lastrow).AutoFilter field:=1, Criteria1:=Target.Value
End If
End If
End With
End Sub
But now I'm trying to do an ActiveX program that loads the Unique value in ComboBox1 from given range and Filter column using the Value of the ComboBox1.
Here is the code which gets the unique values.
Problem is that i have tried to merge both codes to make it work for ComboBox1 but couldn't make it.
Dim v, e
With Sheets("Sheet1").Range("I16:I10000")
v = .Value
End With
With CreateObject("scripting.dictionary")
.comparemode = 1
For Each e In v
If Not .exists(e) Then .Add e, Nothing
Next
If .Count Then Sheets("Sheet1").ComboBox1.List = Application.Transpose(.keys)
End With
I want to merge these both codes in one to work. I have tried but failed.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim lastrow As Long
With Sheets("Sheet1").Range("I15:I" & lastrow)
v = .Value
End With
With CreateObject("scripting.dictionary")
.comparemode = 1
For Each e In v
If Not .exists(e) Then .Add e, Nothing
Next
If .Count Then Sheets("Sheet1").ComboBox1.List = Application.Transpose(.keys)
End With
lastrow = Cells(Rows.Count, "I").End(xlUp).Row
With Me
If Not Intersect(Target, .Range("I1")) Is Nothing Then
If Target.Value <> "" Then
.AutoFilterMode = False
.Range("I15:I" & lastrow).AutoFilter field:=1, Criteria1:=Target.Value
End If
End If
End With
You do not need the Worksheet_Change event anymore because you are not trapping the value from the data validation cell but from a ComboBox1. Paste this code (Untested) in the Sheet1 code area. The below code will automatically filter when you select an item from the ComboBox1. If you want you can also use a CommandButton to run this code.
Let me know if you face an issue?
Private Sub ComboBox1_Click()
If ComboBox1.ListIndex = -1 Then Exit Sub
Dim ws As Worksheet
Set ws = Sheet1
With ws
.AutoFilterMode = False
LastRow = .Range("I" & .Rows.Count).End(xlUp).Row
.Range("I15:I" & LastRow).AutoFilter Field:=1, Criteria1:=ComboBox1.Value
End With
End Sub
Also you need to load the ComboBox1. You can either do that using a CommandButton or you can use the Workbook_Open() event.
When A1 changes, I want to insert a formula to first row and drag it down to last row.
First row is where string "ABC" in column D offset by 2 columns to the right (how do I use offset function instead of just putting 5?)
My try:
Option Explicit
Private Sub WorkSheet_Change(ByVal Target As Range)
Dim firstrow As Long, lastrow As Long
If Not Intersect(Target, Range("A1")) Is Nothing Then
If Target.Count > 1 Then Exit Sub
firstrow = .Cells(Application.WorksheetFunction.Match("ABC", .Range("D:D"), 0), 6)
lastrow = .Cells(fr).End(xlDown).Row
With Range(firstrow, lastrow)
.Formula = "=$F$1+G1"
End With
End If
End Sub
Obviously this doesn't seems to work...
I know there got to be easier and much clever/simpler ways to do this
Thank you for the help.
I'm not sure exactly which column should be used to determine the lastRow, but something like this should do the trick:
Private Sub WorkSheet_Change(ByVal Target As Range)
If Target.CountLarge > 1 Then Exit Sub
If Not Intersect(Target, Me.Range("A1")) Is Nothing Then
Dim firstRow As Variant
firstRow = Application.Match("ABC", Me.Range("D:D"), 0)
If Not IsError(firstRow) Then
Dim lastRow As Long
lastRow = Me.Cells(Me.Rows.Count, "D").End(xlUp).Row
Me.Range("F" & firstRow & ":F" & lastRow).Formula = "=$F$1+G1"
End If
End If
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
Dim lastRow As Long
lastRow = ActiveSheet.Cells(Rows.Count, "E").End(xlUp).Row
ActiveSheet.Unprotect
lastRow.Locked = True
ActiveSheet.Protect
End Sub
*I already run this code. But still not lock the last row.
*When add "MsgBox lastrow" its working and show correct selected row.
*Thank You
Open This For More Info ----> Excel View With Msg Box
In case your cell in Column E is part of a merged cells (in your case Columns E:K are merged), then you set a new Range with the variable MergedCell to the merged area, and then Lock the entire range of merged cells.
Code
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim lastRow As Long, cell As Range, MergedCell As Range
' find last row in Column E
lastRow = ActiveSheet.Cells(Rows.Count, "E").End(xlUp).Row
ActiveSheet.Unprotect
Set cell = Range("E" & lastRow)
' if cell in Column E is part of merged cells
If cell.MergeCells = True Then
Set MergedCell = cell.MergeArea
MergedCell.Locked = True
Else
cell.Locked = True
End If
ActiveSheet.Protect
End Sub