I've got a table I'm tracking progress of various projects in and I want to change the percentage complete (in col G) when the status (in row A) changes. I wrote the script in the middle to change the cell based on the other but the outside piece (meant to make the script run when a cell in Col A changes) I just pulled off the net. Not sure why it isn't working, any help is appreciated.
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Me.Range("A:A")) Is Nothing Then Exit Sub
Application.EnableEvents = False 'to prevent endless loop
Dim LastRow As Long
Dim i As Long
LastRow = Range("A" & Rows.Count).End(xlUp).Row
For i = 3 To LastRow
If Range("A" & i).Value = "Complete" Then
Range("G" & i).Value = 1
End If
Next i
Application.EnableEvents = True
End Sub
Related
i am trying to create a VBA code in excel that uses 3 different values in one line of my excel workbook. I was looking into serveral different codes on stackoverflow and websites to get my process done. For now i haven't found that matches my needs. For now my code looks like this. Without the email function. Sorry my english isn't as good as it seems here. The Workbook
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Me.Range("A1:AA1000")) Is Nothing Then
ThisWorkbook.Save
Application.DisplayAlerts = False
End If
Dim LoadID As Variant
If Not Intersect(Target, Range("D:D")) Is Nothing Then
For Each LoadID In Target
If LoadID >= 1 Then
Range("H" & LoadID.Row).Value = 1
End If
Next LoadID
End If
Dim Ausgang As Variant
If Not Intersect(Target, Range("C:C")) Is Nothing Then
For Each Ausgang In Target
If Ausgang = "Ausgang" Then
Range("H" & Ausgang.Row).Value = 1
End If
Next Ausgang
End If
Dim Eingang As Variant
If Not Intersect(Target, Range("C:C")) Is Nothing Then
For Each Eingang In Target
If Eingang = "Eingang" Then
Range("H" & Eingang.Row).Value = 1
End If
Next Eingang
End If
Dim Four As Variant
If Not Intersect(Target, Range("H:H")) Is Nothing Then
For Each Four In Target
If Four = 4 Then
Range("G" & Four.Row).Value = Now()
End If
Next Four
End If
Dim Three As Variant
If Not Intersect(Target, Range("H:H")) Is Nothing Then
For Each Three In Target
If Three = 3 Then
Range("F" & Three.Row).Value = Now()
End If
Next Three
End If
Dim Two As Variant
If Not Intersect(Target, Range("H:H")) Is Nothing Then
For Each Two In Target
If Two = 2 Then
Range("F" & Two.Row).Value = Now()
End If
Next Two
End If
Dim One As Variant
If Not Intersect(Target, Range("H:H")) Is Nothing Then
For Each One In Target
If One = 1 Then
Range("F" & One.Row).ClearContents
Range("G" & One.Row).ClearContents
Range("J" & One.Row).ClearContents
End If
Next One
End If
End Sub
As for now, it all works like i charm. If i change the H to 4 it should send the value of the same line " LOAD ID " in row D and the Timestamp that will be created via email to a specific person like " Load No. ( LOAD ID ) is ready and on its way since ( TIMESTAMP ). Is there an easy way of learning how to do it ? If anyone could help finding my way i would appricate it very much. Thank you !
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 am updating a sales tool in excel. It currently has 1 small macro that will automatically update when a user inputs or selects a new status by adding a time stamp.
I want to add another macro on the same sheet but in a different range of cells. This would update when a sale is made when the user updates to SOLD to also have a new time stamp. I tried creating a new variable and repeated the If / then statement with new range and new variables but it did not work.
The first If /Then works without issue the myTimeRange, but the 2nd If/then mySoldRange is not.
Here is the code snip
Private Sub Worksheet_Change(ByVal Target As Range)
Dim myTableRange As Range
Dim myDateTimeRange As Range
Dim myUpdatedRange As Range
Dim mySoldRange As Range
Dim mySoldTimeRange As Range
Dim mySoldUpdatedRange As Range
Set myTableRange = Range("A2:E300")
Set mySoldRange = Range("H2:K300")
If Intersect(Target, myTableRange) Is Nothing Then Exit Sub
Set myDateTimeRange = Range("F" & Target.Row)
Set myUpdatedRange = Range("G" & Target.Row)
If myDateTimeRange.Value = "" Then
myDateTimeRange.Value = Now
End If
If Intersect(Target, mySoldRange) Is Nothing Then Exit Sub
Set mySoldTimeRange = Range("H" & Target.Row)
Set mySoldUpdatedRange = Range("K" & Target.Row)
If mySoldTimeRange.Value = "" Then
mySoldTimeRange.Value = Now
End If
myUpdatedRange.Value = Now
mySoldUpdatedTimeRange.Value = Now
End Sub
If Intersect(Target, myTableRange) Is Nothing Then Exit Sub
You can't use Exit Sub here if you want to test if Target intersects another range.
Change instead to:
If Not Intersect(Target, myTableRange) Is Nothing Then
Set myDateTimeRange = Range("F" & Target.Row)
Set myUpdatedRange = Range("G" & Target.Row)
If myDateTimeRange.Value = "" Then
myDateTimeRange.Value = Now
End If
End If
and similarly (though not technically necessary, but to be consistent):
If Not Intersect(Target, mySoldRange) Is Nothing Then
...
End If
Disclaimer: I am not well-versed in VBA and have pieced together the following code by reading various blogs, etc.
My code "works" in that it moves rows whose status is changed to Done from the Active sheet to the Completed sheet. This was the point of the code.
The issue comes when I use the drag button (the little black corner thingy) to create another row on the source sheet (Active sheet). It for some reason copies the header row from the Active sheet to a new row on the Completed sheet.
It must be due to the copy and paste action, but I'm not sure how it's tied to dragging the table to create a row (if at all). Any help or guidance to this VBA amateur would be much appreciated.
Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
Application.EnableEvents = False
'If Cell that is edited is in column H and the value is Done
If Target.Column = 8 And Target.Value = "Done" Then
'Define last row on completed worksheet to know where to place the row of data
LrowCompleted = Sheets("Completed").Cells(Rows.Count, "B").End(xlUp).Row
'Copy and paste data
Range("B" & Target.Row & ":K" & Target.Row).Copy Sheets("Completed").Range("B" & LrowCompleted + 1)
'Delete Row from Project List
Range("B" & Target.Row & ":K" & Target.Row).Delete xlShiftUp
End If
Application.EnableEvents = True
End Sub
On Error Resume Next hides potential errors. For example, Target.Value = "Done" will throw an error if Target is a multi-cell range.
Perhaps try the following:
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column <> 8 Then Exit Sub
If Target.CountLarge <> 1 Then Exit Sub
On Error GoTo SafeExit
Application.EnableEvents = False
If Target.Value = "Done" Then
Dim LrowCompleted as Long
LrowCompleted = Sheets("Completed").Cells(Rows.Count, "B").End(xlUp).Row
Me.Range("B" & Target.Row & ":K" & Target.Row).Copy ThisWorkbook.Sheets("Completed").Range("B" & LrowCompleted + 1)
Me.Range("B" & Target.Row & ":K" & Target.Row).Delete xlShiftUp
End If
SafeExit:
Application.EnableEvents = True
End Sub
I am stuck with a problem i cannot get my head around currently.
I have a checklist that has to update automatically when adding lines to my excel worksheet so that the checklist is applied to all rows.
I tried to use a "for loop" to modify the formula but excel returns Error 1004, when starting the string with "=".
No error but no functionality as well:
ActiveWorkbook.Sheets("Kalkulation Änderungen").Range("AB9").FormulaLocal = "Wenn(Oder(AB" & firstRow & "=""x"""
Returns error 1004:
ActiveWorkbook.Sheets("Kalkulation Änderungen").Range("AB9").FormulaLocal = "=Wenn(Oder(AB" & firstRow & "=""x"""
My first solution
Loop FormulaR1C1, or Formula and use nothing but english Function names eg. sum() instead of Summe() and follow english syntax , instead of ;.
Problem
When testing the syntax without a loop and actual indices it works like a charm. As soon as I try to loop it, Excel does not recognize R[i]C as cell anymore but just returns plain text.
no issues:
ActiveWorkbook.Sheets("Kalkulation Änderungen").Range("AB9").Formula = "IF(OR( R[1]C = ""x"""
issues:
ActiveWorkbook.Sheets("Kalkulation Änderungen").Range("AB9").Formula = "IF(OR( R[i]C = ""x"""
Splitting it like this did not solve my problem either
..R[" & i & "]C =..
Any tips?
// For i= ... to .. next i
// Excel 2007
Try this:
With ActiveWorkbook.Sheets("Kalkulation Änderungen")
'find last row of column AB
LastRow = .Cells(.Rows.Count, "AB").End(xlUp).Row
'apply the formula from AB9 to its last non-blank row
.Range("AB9:AB" & LastRow).Formula = "IF(OR( R[1]C = ""x"""
End With
#UGP: that is what i thought the code might look like after implementing your tips with intersect etc.
What do you think of it, I guess you might not like the loops too much?
Typical beginner approach to loop everything?
I would have to do this for every column accordingly?
If so it would be wise to create a sub () for every column with an exit condition so that i save computing time?
Unless it is possible to hand over the columnadress to the sub_worksheet_change()?
Private Sub Worksheet_Change(ByVal Target As Range, selected_column)
_
_
_
_
Private Sub Worksheet_Change(ByVal Target As Range)
Dim KeyCells As Range
Dim i As Integer
Dim check As Boolean
frstRow = 1
lastRow = 1
i = 1
'Rowcount
Do Until firstRow <> 1 And lastRow <> 1
If ActiveWorkbook.Sheets("Kalkulation Änderungen").Range("D" & i) = "Länge" Then
firstRow = i + 2
i = i + 1
End If
If ActiveWorkbook.Sheets("Kalkulation Änderungen").Range("G" & i) = "Gesamt-h" Then
lastRow = i - 2
End If
i = i + 1
Loop
' check column AB fo "x" and modify header
Set KeyCells = Range("AB" & firstRow, "AI" & lastRow)
check = False
i = firstRow
If Not Application.Intersect(KeyCells, Range(Target.Address)) _
Is Nothing Then
Do While i <= lastRow And check = False
If ActiveWorkbook.Sheets("Kalkulation Änderungen").Range("AB" & i).Value = "x" Then
check = True
ActiveWorkbook.Sheets("Kalkulation Änderungen").Range("AB9").Value = "x"
ElseIf i = lastRow And check = False Then
ActiveWorkbook.Sheets("Kalkulation Änderungen").Range("AB9").Value = " "
End If
i = i + 1
Loop
End If
End Sub
Here's the code. It has to be in the corresponding worksheet in the VBA-Editor.
It activates when a cell in Range(A10:A20) has been changed.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim KeyCells As Range
Set KeyCells = Range("A10:A20")
If Not Application.Intersect(KeyCells, Range(Target.Address)) _
Is Nothing Then
If Target.Count = 1 Then
If Target.Value = "x" Then
'Your Code
'i.e
MsgBox (Target.Address & "has been changed")
End If
Else
MsgBox ("Please No Copy Pasterino")
End If
End If
End Sub
EDIT:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim KeyCells As Range
Dim i As Integer
Dim fRow As Long, lRow As Long
Dim check As Boolean
Dim sht As Worksheet
Dim Cell As Range
Set sht = Worksheets("Tabelle1")
'Rowcount
fRow = 2
lRow = sht.Cells(sht.Rows.Count, "G").End(xlUp).Row
' check column AB fo "x" and modify header
Set KeyCells = Range("AB" & fRow & ":AI" & lRow)
If Not Application.Intersect(KeyCells, Range(Target.Address)) _
Is Nothing Then
For Each Cell In Range(Cells(fRow, Target.Column), Cells(lRow, Target.Column))
If Cell.Value = "x" Then
sht.Cells(9, Target.Column).Value = "x"
Exit For
Else
sht.Cells(9, Target.Column).Value = ""
End If
Next
End If
End Sub