I'm trying to get an simple way of copy a value from a cell in one sheet to another cell on a other sheet based on cell trigger. I got simply a cell trigger event that calls a sub;
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Selection.Count = 1 Then
If Not Intersect(Target, Range("C:C")) Is Nothing Then
Application.Run "Workorder"
'Application.Run "'my-calc2 - visualtest2.xls'!line"
'Range("A" & ActiveCell.Row & ":J" & ActiveCell.Row).Value = Range("Requester name")
End If
End If
End Sub
The sub I'm calling is
Sub workorder()
Range("Requester_name").Value = Range(ActiveCell.Row, 3)
End Sub
But this last sub is where I get stuck, what am I doing wrong?
Related
First let me say that I am freshly new to VBA coding. My spreadsheet has 8 tabs(1 hidden and 1's a chart). Of the other 6 tabs, I would like the code to be able to run on them as well, I just don't know how. I have two sets of code and I am trying to combine them. They are event related codes. I can get them both to run separately but only on a specified sheet. I'm testing them on the "New" tab. The first code sorts the rows after the date is entered into column "H". The other code will cut and paste the entire row into the corresponding tab based on a selection from the drop down list in column "O". I created a call function for both however, only the first code will do anything. Here is what I have so far:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rngChng As Range
Set rngChng = Intersect(Target, Range("H:H"))
If rngChng Is Nothing Then Exit Sub
If Target.Cells.Count > 1 Then Exit Sub
Application.ScreenUpdating = False
Call AutoSort(rngChng)
Set rngChng = Intersect(Target, Range("O:O"))
If rngChng Is Nothing Then Exit Sub
If Target.Cells.Count > 1 Then Exit Sub
Call CopyNPaste(rngChng)
Application.ScreenUpdating = True
End Sub
Sub AutoSort(rngChng As Range)
Range("A2:O1000").Sort Key1:=Range("H1"), Order1:=xlAscending, Header:=xlNo
End Sub
Sub CopyNPaste(rngChng As Range)
Dim ws As Worksheet
For Each ws In Sheets
If ws.Name <> "New" Then
If ws.Name = Target Then
Target.EntireRow.Copy Sheets(ws.Name).Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
Target.EntireRow.Delete Shift:=x1Up
End If
End If
Next ws
End Sub
To run the same code from many sheets move the code to a module. Use insert->module on the menu bar, if there are no others it will be named Module1.
In each relevant sheet add the code
Private Sub Worksheet_Change(ByVal Target As Range)
Call Module1.sortOrCopy(Target)
End Sub
Put the sortOrCopy sub in the module. I would suggest using the Target.column
value rather than Intersections to control the program flow.
Put the target.cells.count check once at the start. Pass parameters to your 2 subs.
Sub sortOrCopy(ByVal Target As Range)
If Target.Cells.Count > 1 Then Exit Sub
Dim ws As Worksheet
Set ws = Target.Parent
If Target.Column = 8 Then ' col H
Call AutoSort(ws)
ElseIf Target.Column = 15 Then ' col O
Call CopyNPaste(Target)
End If
End Sub
For the AutoSort sub the only parameter required is the sheet which will be Target.parent.
You can set the sort range rather than hard coding it using .end(xlUp.row as you have in the other sub.
Sub AutoSort(ws As Worksheet)
Dim iLastRow As Long
' last row of sort range
iLastRow = ws.Range("H" & Rows.Count).End(xlUp).Row
Application.ScreenUpdating = False
Range("A2:O" & iLastRow).Sort Key1:=Range("H1"), Order1:=xlAscending, Header:=xlNo
Application.ScreenUpdating = True
End Sub
For the sub CopyNPaste, pass the Target so that the source,row and destination can be determined.
Try to structure the code in simple steps by not doing too much in one line. If the code doesn't work as expected it is easier then to add debug.print or msgBox statements at the various steps. Comment out the If .. End if you don't want user confirmation of the change.
Sub CopyNPaste(Target)
Dim wsCopyTo As Worksheet, iInsertRow As Long, text As String
Set wsCopyTo = Sheets(Target.Value)
' find last row on CopyTo sheet, insert below
iInsertRow = 1 + wsCopyTo.Range("A" & Rows.Count).End(xlUp).Row
text = "Copy line to sheet " & wsCopyTo.Name & " row " & iInsertRow
If MsgBox(text, vbYesNo) = vbYes Then
With Target.EntireRow
.Copy wsCopyTo.Range("A" & iInsertRow)
.Delete Shift:=xlShiftUp
End With
End If
End Sub
So I am trying to find a solution where i can copy paste multiple values from one column into another column and have it leave out duplicates already existing.
I found this code but it only works if I copy paste one value at a time.
Is there a way to make it work so it will paste in unique copied values only, that does not exist in the column already?
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
''''''''''''''''''''''''''''''''''''''''''
'Prevents duplicate entries in Column A
''''''''''''''''''''''''''''''''''''''''''
If Target.Cells.Count > 1 Then Exit Sub
If Target.Column = 1 And Target <> vbNullString Then 'Column A
If WorksheetFunction.CountIf(Columns(1), Target) > 1 Then
MsgBox "Entry " & Target & " already exists!", _
vbCritical, "Dixons Travel Oslo"
Target = ""
Target.Select
End If
End If
End Sub
Maybe you find this usefull:
Below code assumes you just copy in all the values, even if they exist allready.
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 1 Then
Range("A1", Range("A1").End(xlDown)).RemoveDuplicates Columns:=1, Header:=xlNo
End If
End Sub
It will look like this:
Change Header:=xlNo to Header:=xlYes if that applies to your situation.
Obviously, there are other ways. I just find this quite easy.
Using a similar methodology to your existing one, you could do the following:
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Application.EnableEvents = False
For Each tcell In Target.Cells
With tcell
If .Column = 1 And .Value <> vbNullString Then 'Column A
If WorksheetFunction.CountIf(Columns(1), .Value) > 1 Then
tcell.Value = ""
End If
End If
End With
Next
Application.EnableEvents = True
End Sub
Here's another way - expanding and improving on JvdV's idea:
Private Sub Worksheet_Change(ByVal Target As Range)
With Target.Parent
If Not (Intersect(Target, .Columns(1)) Is Nothing) Then
Range("A1", Range("A" & .Rows.Count).End(xlUp)).RemoveDuplicates Columns:=1, Header:=xlNo
End If
End With
End Sub
This allows for multiple cells to be pasted - regardless of how many columns are affected and de-dupes the whole of column A.
You could try:
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
If Target.Column = 1 Then
Application.EnableEvents = False
ThisWorkbook.Worksheets("Sheet1").Columns("A:A").RemoveDuplicates Columns:=1, Header:=xlNo
Application.EnableEvents = True
End If
End Sub
Notes:
You could change sheet name
Header option
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.
I have this macro which takes data from the Clipboard and paste it into an specific cell transposing some information.
Sub UpdateData()
'~~> Change this to the relevant sheet
Set ws = ThisWorkbook.Sheets("Sheet2")
With ws
'~~> Using this as you are copying it from Notepad~~~~
.Activate
.Range("H1").Select
.PasteSpecial Format:="Text", Link:=False, DisplayAsIcon:=False
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Worksheets("Sheet2").Range("H1" & ",H3").Copy
Sheets("Sheet2").Range("C" & Rows.Count).End(xlUp).Offset(1).PasteSpecial Transpose:=True
'~~Clear data content~~~~~~~~~~~~~~~~~~~~~~~~~
Range("H1:H10").ClearContents
End With
End Sub
I need this macro to update the cell B next to the line updated (C) with the NOW formula.
I have this other macro which updates the Row B whenever the Row C is updated, but they're not working together.
Sub Worksheet_Change(ByVal Target As Range)
Application.MoveAfterReturn = True
If Target.Count = 1 Then
If Not Intersect(Target, Range("C1:C1000")) Is Nothing Then
Cells(Target.Row, "B") = Now
End If
End If
End Sub
Any ideas on how should I do it?
The Target is the cell or cells that have changed and triggered the Worksheet_Change event macro. In your case, this is multiple cells so you have to deal with each individually.
Sub Worksheet_Change(ByVal Target As Range)
Application.MoveAfterReturn = True
If Not Intersect(Target, Range("C1:C1000")) Is Nothing Then
On Error GoTo bm_Safe_Exit
Application.EnableEvents = False
Dim c As Range
For Each c In Intersect(Target, Range("C1:C1000"))
Cells(c.Row, "B") = Now
Next c
End If
bm_Safe_Exit:
Application.EnableEvents = True
End Sub
Turn off event handling while you are changing data (adding a timerstamp) to the worksheet or you will trigger the Worksheet_Change to run on top of itself.
After determining that one or more cells in the C1:C1000 range has been altered, the For Each ... Next Statement cycles through each cell and deposits a timestamp on that row's column B.
I have code that retrieves information from SQL and VFP and populates a dropdown list in every cell in column "A" except A1 - this is a header.
I need to populate the "G" column on the row where the user selects the value from a dropdown in the "A" column.
I believe I need to be in Private Sub Worksheet_SelectionChange(ByVal Target As Range) which is in the sheet object.
Below is something similar to what I want to do.
If cell "a2".valuechanged then
Set "g2" = "8000"
End if
If cell "a3".valueChanged then
Set "g3" = "8000"
End if
The code above doesn't work, but I think it is easy to understand. I want to make this dynamic, so I don't have too many lines of code.
I have already explained about events and other things that you need to take care when working with Worksheet_Change HERE
You need to use Intersect with Worksheet_Change to check which cell the user made changes to.
Is this what you are trying?
Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo Whoa
'~~> Check if user has selected more than one cell
If Target.Cells.CountLarge > 1 Then Exit Sub
Application.EnableEvents = False
'~~> Check if the user made any changes in Col A
If Not Intersect(Target, Columns(1)) Is Nothing Then
'~~> Ensure it is not in row 1
If Target.Row > 1 Then
'~~> Write to relevant cell in Col G
Range("G" & Target.Row).Value = 8000
End If
End If
Letscontinue:
Application.EnableEvents = True
Exit Sub
Whoa:
MsgBox Err.Description
Resume Letscontinue
End Sub
Try this
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Row > 1 And Target.Column <> 7 Then
Cells(Target.Row, "G").Value = 8000
End If
End Sub
If you only need it to fire on column A then
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Row > 1 And Target.Column = 1 Then
Cells(Target.Row, "G").Value = 8000
End If
End Sub
can you not put an if statement in column G , as in
If (A1<>"", 8000,0)
Other wise something like this will get you going:
Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
If Target.Column = 1 Then
If Target.Value2 <> "" Then
Target.Offset(0, 6) = "8000"
Else
Target.Offset(0, 6) = ""
End If
End If
On Error GoTo 0
End Sub
Thanks
Ross
I had a similar problem. I used Siddharth Rout's code. My modifications allow a user to paste a range of cells in column a (ex. A3:A6) and have multiple cells modified (ex. H3:H6).
Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo Whoa
'~~> Check if user has selected more than one cell
If Target.Cells.CountLarge < 1 Then Exit Sub
If Target.Cells.CountLarge > 500 Then Exit Sub
Debug.Print CStr(Target.Cells.CountLarge)
Application.EnableEvents = False
Dim the_row As Range
Dim the_range As Range
Set the_range = Target
'~~> Check if the user made any changes in Col A
If Not Intersect(the_range, Columns(1)) Is Nothing Then
For Each the_row In the_range.Rows
'~~> Ensure it is not in row 2
If the_row.Row > 2 Then
'~~> Write to relevant cell in Col H
Range("H" & the_row.Row).Value = Now
End If
Next
End If
Letscontinue:
Application.EnableEvents = True
Exit Sub
Whoa:
MsgBox Err.Description
Resume Letscontinue
End Sub