i want to adjust the following code but I have no clue how to do that...I searched through some threads here ("Combine two Private Sub Worksheet) but I didn't get a solution that worked so far.
So I am kindly asking for your help since my VBA skills are...limited.
enter code here
Private Sub Worksheet_Change(ByVal Target As Range)
Const Spalte As Integer = 17
Dim C As Range
If Not Intersect(Target, Columns(Spalte)) Is Nothing Then
Set Target = Intersect(Target, Columns(Spalte))
For Each C In Target
C.Offset(0, 1).Value = Format(Date, "dd.mm.yyyy") & " um" &
Format(Now(), " hh:mm:ss") & " durch " &
ActiveWorkbook.BuiltinDocumentProperties(7)
Next
End If
Set C = Nothing
End Sub
All I wanna do now is adjust it, so it also checks whether column 16 was changed or not. If either column 16 OR 17 was changed it should write the date and so on in column 18.
Thank you so much for your help!
Here is one way:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim r As Range
Dim C As Range
Set r = Range("P:Q")
If Not Intersect(Target, r) Is Nothing Then
For Each C In Intersect(Target, r)
Cells(C.Row, 18).Value = Format(Date, "dd.mm.yyyy") & " um" & _
Format(Now(), " hh:mm:ss") & " durch " & ActiveWorkbook.BuiltinDocumentProperties(7)
Next
End If
Set C = Nothing
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 need to combine the following 3 subroutines into a single worksheet change event but I am unsure how.
I have tried writing one sub in the worksheet editor and another in the workbook editor. However given that I have 3 subroutines all referring to the same worksheet, I am unsure how to combine them. Any help is greatly appreciated!
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("D3:D100")) Is Nothing Then
Exit Sub
Else
Dim i As Integer
For i = 3 To 100
If Range("D" & i).Value = "Remote" Then
Range("O" & i).Value = "N/A"
Range("P" & i).Value = "N/A"
Range("Q" & i).Value = "N/A"
End If
Next i
End If
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target,Range("H3:H100")) Is Nothing Then
Exit Sub
Else
Dim e As Integer
For e = 3 To 100
If Range("H" & e).Value = 1 Then
Range("I" & e).Value = "N/A"
End If
Next e
End If
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target,Range("I3:I100")) Is Nothing Then
Exit Sub
Else
Dim e As Integer
For e = 3 To 100
If Range("I" & e).Value = 1 Then
Range("H" & e).Value = "N/A"
End If
Next e
End If
End Sub
Flip the logic.
If Intersect(Target, Range("D3:D100")) Is Nothing Then
Exit Sub
Else
...
End If
Change this to
If Not Intersect(Target, Range("D3:D100")) Is Nothing Then
' Remove Exit Sub
' Remove Else
...
End If
Do the same for the two other Intersect calls and then combine everything into one Worksheet_Change handler.
Most likely you want to disable events as well, to avoid re-triggering the event when writing to the sheet:
Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo SafeExit
Application.EnableEvents = False
' Your three Intersect checks
SafeExit:
Application.EnableEvents = True
End Sub
try this. put this in the worksheet, not the workbook
Private Sub Worksheet_Change(ByVal Target As Range)
Dim c As Integer
If Not Intersect(Target, Range("D3:D100")) Is Nothing Then
c = 1
Else
If Not Intersect(Target, Range("H3:H100")) Is Nothing Then
c = 2
Else
If Not Intersect(Target, Range("I3:I100")) Is Nothing Then
c = 3
End If
End If
End If
Select Case c
Case 1
' your stuff
Case 2
'your stuff
Case 3
'your stuff
Case Else
End Select
End Sub
Good day, i got a set of code as below:
Dim oval
Public Sub Worksheet_SelectionChange(ByVal Target As Range)
oval = Target.Value
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("C2:C1048576")) Is Nothing Then
Range("G" & Target.Row) = Now()
Range("H" & Target.Row) = oval
End If
End Sub
This is supposed to update column "G" with current date and time while column "H" with previous content in "C" should a change detected in column "C".
While this code is working, i got an issue whereby deleting a row of data in the middle of the table will shift the lower row up to the deleted row but it will update the column "G" and "H" as well.
is there a way to prevent that? thank you.
This will solve some of your problems:
Dim oval
Public Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Count > 1 Then Exit Sub
oval = Target.Value
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count > 1 Then Exit Sub
If Not Intersect(Target, Range("C2:C1048576")) Is Nothing Then
Application.EnableEvents = False
Range("G" & Target.Row) = Now()
Range("H" & Target.Row) = oval
Application.EnableEvents = True
End If
End Sub
I would get rid of the public variable and Worksheet_SelectionChange event macro. Application.Undo can be applied within the Worksheet_Change event macro after recording the changed values.
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("C:C")) Is Nothing Then
On Error GoTo bm_Safe_Exit
Application.EnableEvents = False
Dim rng As Range, vCEEs As Variant
vCEEs = Range(Cells(1, "C"), Cells(Rows.Count, "C").End(xlUp)).Value
Application.Undo
For Each rng In Intersect(Target, Range("C:C"))
Range("G" & rng.Row) = Now()
Range("H" & rng.Row) = Range("C" & rng.Row)
Range("C" & rng.Row) = vCEEs(rng.Row, 1)
Next rng
End If
bm_Safe_Exit:
Application.EnableEvents = True
End Sub
This should survive pasting multiple values into column C but you risk losing values pasted into other columns.
How do I do this in Excel? I used this to work for column A but I also want to do additional columns
Private Sub Worksheet_Change(ByVal Target As Range)
Dim T As Range, r As Range
Set T = Intersect(Target, Range("A:A"))
If T Is Nothing Then Exit Sub
Application.EnableEvents = False
For Each r In T
With r
.Offset(0, 1).Value = .Offset(0, 1).Value + .Value
.ClearContents
End With
Next r
Application.EnableEvents = True
End Sub
Try this:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim T As Range, r As Range
Dim columnArray() As String, columnsToCopy As String
Dim i As Integer
columnsToCopy = InputBox("What columns (A,B,C, etc.) would you like to copy the data of? Use SPACES, to separate columns")
columnArray() = Split(columnsToCopy)
For i = LBound(columnArray) To UBound(columnArray)
Set T = Intersect(Target, Range("" & columnArray(i) & ":" & columnArray(i) & "")) 'Columns(columnArray(i)) & ":" & Columns(columnArray(i))))
If T Is Nothing Then Exit Sub
Application.EnableEvents = False
For Each r In T
With r
.Offset(0, 1).Value = .Offset(0, 1).Value + .Value
.ClearContents
End With
Next r
Next i
Application.EnableEvents = True
End Sub
That will create a popup, asking you for the columns you want to run this on. What's the thought behind running this every time a cell changes? That's going to be a lot of pop-ups, etc. But let me know if this doesn't work or has some error.
Trying to set the number format of a cell based on the currency selected on an adjacent cell using VBA. See sample below.
So far I am using the below code but I cannot seem to make the format to appear properly
Option Explicit
Public preValue As Variant
Private Sub Worksheet_Change(ByVal Target As Range)
Dim cell As Range
Dim Rng As Range
Dim ccy As String
ccy = Range("A3").Value
pctFormat = "0.000%"
fxFormat = ccy + " " + pctFormat
If Target.Cells.Count > 1 Then Exit Sub
On Error Resume Next
If Not Intersect(Target, Range("A2:A10")) Is Nothing Then
If Target.Value <> preValue And Target.Value <> "" Then
Application.EnableEvents = False
Cells(Target.Row, Target.Column + 1).NumberFormat = fxFormat
Application.EnableEvents = True
End If
End If
On Error GoTo 0
End Sub
you could try this option to set your fxFormat variable:
fxFormat = "[$" & ccy & "] 0.000%"
perhaps:
fxFormat = chr(34) & ccy & chr(34) & " " & pctFormat