I am trying to create a macros that will allow me each time it's activated to copy the value of a cell in worksheet 1 (the same cell but which would probably have differrent results after my calculation) and to paste the value of those results in worksheet 2 (maybe in A1;A2;A3;....... each time I make a calcul) this is a sample of a code i have written but which isn'working:
Sub recorder()
If Cells(B, i) <> Empty Then
i = i + 1
Worksheets(1).Select
Cells(A1).Copy
Worksheets(2).Select
Cells(B, i) = Cells(A1)
End If
End Sub
Any help would be appreciated. Thanks
Paste this into ThisWorkbook.
Whatever you change the value in Cell A1 on Sheet1 it will appear on Sheet2 in the nearest blank cell in column A. Note you don't need to run a macro it happens automatically.
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
If Not Sh.Index = 1 Then Exit Sub
If Not Target.Address = "$A$1" Then Exit Sub
If Worksheets(2).Range("A65536").End(xlUp).Value = Empty Then
Worksheets(2).Range("A65536").End(xlUp).Value = Target.Value
Else
Worksheets(2).Range("A65536").End(xlUp).Offset(1, 0).Value = Target.Value
End If
End Sub
I think this is what you're looking for:
Sub recorder()
Sheets(2).Cells(Rows.Count, "B").End(xlUp).Offset(1).Value = Sheets(1).Range("A1").Value
End Sub
Related
So have this button on a form and I cant make the data on 3 cells (Ex:C1,D1,E1) go down 1 Row without shifting the whole sheet.
How do i make the values go down after being inserted so that i can leave Row1 allways open for new values?
This is the code on the command button, can i embed the solution on it or do I have to do it somewhere else?
Private Sub CommandButtonAddDes_Click()
Dim emptyRow As Long
'Activate sheet
Sheet1.Activate
'Determine emptyRow
emptyRow = WorksheetFunction.CountA(Range("C:C")) + 1
'Transfer info
Cells(emptyRow, 3).Value = Des
Cells(emptyRow, 4).Value = ComboBox.Value
Cells(emptyRow, 5).Value = TextBox1.Value
End Sub
Looks like you want to make sure that the cells being updated are then moved down automatically. You can do that with a change event on the sheet code behind like this:
Sub Worksheet_Change(ByVal Target As Range)
'Checks if the column being changed is C - E
If Target.Column = 3 Or Target.Column = 4 Or Target.Column = 5 Then
'Checks if the row being changed is row 2
If Target.Row = 2 Then
'Inserts a new row and pushes what is in C2:E2 down one row
Range("C2:E2").Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
End If
End If
End Sub
This code will go in the sheets code behind. So, you will have to right-click on the sheet that you have this data on and then click on view code (or just double-click the sheet)
Putting the code there will tell Excel to watch that sheet for changes and then the code checks if it is happening to one of those 3 cells (C2:E2)
With data in C1, D1 and E1 just:
Range("C1:E1").Insert Shift:=xlDown
This pushes down the three cells rather than the entire row.
EDIT#1:
Put this event macro in the worksheet code area:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim c As Long
c = Target.Column
If c = 3 Or c = 4 Or c = 5 Then
If Application.WorksheetFunction.CountA(Range("C1:E1")) = 3 Then
Application.EnableEvents = False
Range("C1:E1").Insert shift:=xlDown
Application.EnableEvents = True
End If
End If
End Sub
Once you have entered all 3 values in C1 through E1, the values will get pushed down automatically.
Replace you code on your userform. Ensure your input box names are correct, i.e. ComboBox1, TextBox1, etc. I don't understand what "Des" is. If you need it in row 2 then just change the 1s to 2s.
Private Sub CommandButton1_Click()
With Sheets("Sheet1")
.Range("C1:E1").Insert Shift:=xlDown
.Range("C1").Value = Des.Value
.Range("D1").Value = ComboBox.Value
.Range("E1").Value = TextBox1.Value
End With
End Sub
Edited: changed lat column index from "D" to "E" and starting row index from "3" to "2"
Maybe you’re after this
Private Sub CommandButtonAddDes_Click()
With Sheet1
With .Range("C2:E" & .Cells(.Rows.Count, "C").End(xlUp).Row)
.Offset(1).Value = .Value
.Resize(1) = Array(Des, ComboBox.Value, TextBox1.Value)
End With
End With
End Sub
Should different rows need to be "inserted" you just change the row index.
I need help with an macro to notify me (by changing a cell background color to red), when the value (always number format) changes in any cells in the row. I want the background of cell E3 to change to red, if any of the values in cells F3:AN3 change from their current values.
The numbers in cells F3:AN3 will be entered manually or thru copy and paste of the row, and there won't be any formulas. Likewise, if any values in cells F4:AN4 are changed, I would like cell E4 to change to a red background, and so on for each of the rows in the chart. Not all rows will always have a value, so I would be looking for changes from "" to any #, or from one # to another #, or from any # to "". Ideally this would be an event macro that does not have to be run manually.
The following is the code I've started working with:
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("F3:AN3")) Is Nothing Then KeyCellsChanged
End Sub
Private Sub KeyCellsChanged()
Dim Cell As Object
For Each Cell In Range("E3")
Cell.Interior.ColorIndex = 3
Next Cell
End Sub
However, this macro seems to run regardless of whether the number in the cell is changed, as long as I press enter it highlight E3 as red.
Any help is much appreciated!
Here is my favorite way to detect changes in an Excel VBA app:
Create an exact copy of the range you're watching in hidden rows below the range the user sees.
Add another section below that (also hidden) with formulas subtracting the user range with the hidden range with an if statement that sets the value to 1 if the difference is anything but 0.
Use conditional formatting in the user range that changes the background color of the row if the corresponding change-detection row (or cell) is > 0.
What I like about this approach:
If a user makes a change and then reverts back to the original value, the row is "smart enough" to know that nothing has changed.
Code that runs any time a user changes something is a pain and can lead to problems. If you set up your change detection the way I'm describing, your code only fires when the sheet is initialized. The worksheet_change event is expensive, and also "may effectively turn off Excel’s Undo feature. Excel’s Undo stack is destroyed whenever an event procedure makes a change to the worksheet." (per John Walkenbach: Excel 2010 Power Programming)
You can detect if the user is navigating away from the page and warn them that their changes will be lost.
Depending on your answer to my question in the comments, this code may change. Paste this in the relevant Worksheet code area. For this to work, navigate to any other sheet and then navigate back to the original sheet.
Option Explicit
Dim PrevVal As Variant
Private Sub Worksheet_Activate()
If Selection.Rows.Count = 1 And Selection.Columns.Count = 1 Then
PrevVal = Selection.Value
Else
PrevVal = Selection
End If
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
On Error GoTo ExitGraceFully
If Selection.Rows.Count = 1 And Selection.Columns.Count = 1 Then
PrevVal = Selection.Value
Else
PrevVal = Selection
End If
ExitGraceFully:
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
If Application.WorksheetFunction.CountA(Target) = 0 Then Exit Sub
Dim aCell As Range, i As Long, j As Long
On Error GoTo Whoa
Application.EnableEvents = False
If Not Intersect(Target, Columns("F:AN")) Is Nothing Then
If Target.Rows.Count = 1 And Target.Columns.Count >= 1 Then
Range("E" & Target.Row).Interior.ColorIndex = 3
ElseIf Target.Rows.Count > 1 And Target.Columns.Count = 1 Then
i = 1
For Each aCell In Target
If aCell.Value <> PrevVal(i, 1) Then
Range("E" & aCell.Row).Interior.ColorIndex = 3
End If
i = i + 1
Next
ElseIf Target.Rows.Count > 1 And Target.Columns.Count > 1 Then
Dim pRow As Long
i = 1: j = 1
pRow = Target.Cells(1, 1).Row
For Each aCell In Target
If aCell.Row <> pRow Then
i = i + 1: pRow = aCell.Row
j = 1
End If
If aCell.Value <> PrevVal(i, j) Then
Range("E" & aCell.Row).Interior.ColorIndex = 3
End If
j = j + 1
Next
End If
End If
LetsContinue:
Application.EnableEvents = True
Exit Sub
Whoa:
Resume LetsContinue
End Sub
SNAPSHOTS
It works as expected When you type a value in the cell. It also works when you copy 1 Cell and paste it in multiple cells. It doesn't work when you copy a block of cells and do a paste (I am still working on this)
NOTE: This is not extensively tested.
I need to build a linked search function in VBA that also auto-updates after you enter data into the given search fields. I have been able to do this successfully with the following sections of code:
Autofilter search - in a standard module
Code:
Sub FilterTo1Criteria()
With Sheet3
If Range("A3") <> vbNullString Then
.AutoFilterMode = False
.Range("A6:J1015").AutoFilter
.Range("A6:J1015").AutoFilter Field:=1, Criteria1:=Range("A3")
Else
Selection.AutoFilter
End If
End With
End Sub
Sheet change/auto-update - This is in a worksheet module
Code:
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$A$3" Then
Application.EnableEvents = False
FilterTo1Criteria
Application.EnableEvents = True
End If
End Sub
However, within the sheet change page, I need cells A3:J3 to be the criteria, but I also need the auto search function to work if only A3 and D3 are filled in, or if just A3 is filled in (D3 is blank), or if just D3 is filled in (A3 is blank), but I'm having issues trying to compound the code to get this effect. How much more complicated will I have to make it? Are there some examples that someone is aware of that I can look at to glean some information from? It's hard to find any...
A slicer with a pivot table is a potential way to go, but I think some people downstream are using Excel 2003 and I don't think the slicer works back that far.
Thanks in advance!
For the function to work if either A3 or D3 are not empty, then you can concatenate the two cells and compare that to vbNullString.
For the multiple filters, you can use a loop to set them all.
eg:
Sub FilterTo1Criteria()
Dim i As Long
With Sheet3
If Range("A3") & Range("D3") <> vbNullString Then
.AutoFilterMode = False
.Range("A6:J1015").AutoFilter
For i = 1 To 10
.Range("A6:J1015").AutoFilter Field:=i, Criteria1:=Cells(3, i)
Next i
Else
Selection.AutoFilter
End If
End With
End Sub
Edit:
It looks like you wanted to set the filters as the criteria cells were filled, rather than all at once. Try this instead:
Sub FilterTo1Criteria()
Dim i As Long
With Sheet3
.AutoFilterMode = False
.Range("A6:J1015").AutoFilter
For i = 1 To 10
If .Cells(3, i) <> vbNullString Then
.Range("A6:J1015").AutoFilter Field:=i, Criteria1:=.Cells(3, i)
End If
Next i
End With
End Sub
and for the new worksheet change sub:
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("$A$3:$J$3")) Is Nothing Then
Application.EnableEvents = False
FilterTo1Criteria
Application.EnableEvents = True
End If
End Sub
This will add or remove filters as you add or remove criteria (row 3).
I am very inexperienced with VBA and coding in general.
I am working on a spreadsheet where column A is job numbers.
Column B is Dates.
Columns C, D and E you have to put a mark in E.G Text that has no pattern.
Now I have worked out code to put the date in column B if any mark is put in C, D or E. However if you then delete C, D or E the cell in column B is still populated with the date.
Just to be clear C, D or E could have text in them or on 2 or 1.
Now I know you could just delete the cell but where is the fun in that .
Here is the code I have so far please feel free to suggest way to make it smaller or clear it up, but mainly away to sort out my issue thanks in advance.
Private Sub Worksheet_Change(ByVal Target As Range)
Call Macro1(Target)
Call Macro2(Target)
Call Macro3(Target)
End Sub
Sub Macro1(ByVal Target As Range)
If Target.Cells.Count > 1 Then Exit Sub
If Not Intersect(Target, Range("c2:c100")) Is Nothing Then
With Target(1, 0)
.Value = Date
.EntireColumn.AutoFit
End With
End If
End Sub
Sub Macro2(ByVal Target As Range)
If Target.Cells.Count > 1 Then Exit Sub
If Not Intersect(Target, Range("d2:d100")) Is Nothing Then
With Target(1, -1)
.Value = Date
.EntireColumn.AutoFit
End With
End If
End Sub
Sub Macro3(ByVal Target As Range)
If Target.Cells.Count > 1 Then Exit Sub
If Not Intersect(Target, Range("e2:e100")) Is Nothing Then
With Target(1, -2)
.Value = Date
.EntireColumn.AutoFit
End With
End If
End Sub
This code either inserts a date in Column B when columns C, D or E in that row are changed and at least one of them is non-blank. Conversely, the cell in Column B is cleared if all three are blank:
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Cells.Count > 1 Then Exit Sub
If Not Intersect(Target, Me.Range("c2:E100")) Is Nothing Then
With Intersect(Target.EntireRow, Me.Range("B2:B100"))
If WorksheetFunction.CountBlank(Intersect(Target.EntireRow, Me.Range("C2:E100"))) <> 3 Then
.Value = Date
.EntireColumn.AutoFit
Else
.Value = ""
End If
End With
End If
End Sub
you just add a check
If Target.Value = "" Then dateCell.ClearContents
where dateCell is the cell where the date resides in the current row
but you must also:
disable/enable events
to prevent Worksheet_Change() fire again when changing "date" cell (this occurs also when deleting a cell value
use one sub to handle all three columns
just check if target intersects columns C to E. like
If Not Intersect(.Cells, Range("C:E")) Is Nothing Then
see code:
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Call Macro1(Target)
End Sub
Sub Macro1(ByVal Target As Range)
Dim dateCell As Range
With Target
If .Cells.Count > 1 Then Exit Sub
Application.EnableEvents = False '<--| disable events to prevent this one fire when changing "date" cell
If Not Intersect(.Cells, Range("C:E")) Is Nothing Then
Set dateCell = Cells(.row, "B") '<--| set the cell where "date" resides
If Application.WorksheetFunction.CountA(.Parent.Cells(.row, "C").Resize(, 3)) = 0 Then '<--| if there are no values in current row columns C to E ...
dateCell.ClearContents '<--|... clear the date
Else
dateCell.Value = Date '<--|... otherwise put the date in column B and ...
dateCell.EntireColumn.AutoFit '<--| ... autofit column B
End If
End If
Application.EnableEvents = True '<--| enable events back on
End With
End Sub
I am trying to add an archive sheet to my workbook where closed tickets are collected. I would like the row of a particular ticket to be cut from a sheet labeled 'Tickets' and pasted into a sheet labeled 'Archive' once its status has changed from open to closed. I would like this to happen using a private sub so that it happens on cell change. The Status is found in column 4.
If that is possible im assuming it will be possible to do it the other way round too. So if a ticket is re-opened again and its status is changed in the 'Archive' sheet it will be cut and paste back into the 'Tickets' sheet.
This is the code we have so far. We can seem to get it to work. Any help would be greatly appreciated. Thank you
Private Sub Worksheet_Change (ByVal Target As Range)
If Target.Column = 4 Then
If Target.Value = "Closed" Then
R = Target.Row
Rows(R).Cut
Worksheets("Archive").Select
With ActiveSheet
lastrow = .Cells(.Rows.Count,"B").End(xlUp).Row
End With
Cells(lastrow,1).Select
Selection.Paste
End If
End If
End sub
Just making small amendments to your current code:
If Target.Column = 4 Then
If Target.Value = "Closed" Then
R = Target.Row
Rows(R).Cut
Worksheets("sheet3").Select
With ActiveSheet
lastrow = .Cells(.Rows.Count, "B").End(xlUp).Row + 1
.Cells(lastrow, 1).Select
.Paste
End With
End If
End If