Excel macro add two cells into one of them - vba

I am absolutely new in macro and need a little help.
The two columns are "O" and "P". After a user writes a number into O2 and clicks double (or press a button) the macro has to add O2 and P2 together and show the result in P2. The problem is it should work for O3-P3, O4-P-4 until forever but O1-P1.
Can anybody help?
It would be great if the value was deleted in O2 after the double click (or button).

Look, usually you have to do some code and then you ask for input on what is not working/what you want to achieve. It is not cool to come and ask for free code.
That being said, the work here is kinda slow right now, and this wasn't that hard.
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Not Intersect(Target, Range(Cells(2, 16), Cells(Cells(Rows.Count, 16).End(xlUp).Row, 16))) Is Nothing Then
Selection.Value = Selection.Value + Cells(Selection.Row, 15).Value
Cells(Selection.Row, 15).Value = vbNullString
End If
End Sub
You have to put this code on the sheet you want the Double Click to happen. If you don't know how, you do it by pressing ALT+F11. Then, on the left, you click on the sheet (In my case Plan1. It may vary based on the language your excel is. Here is a reference image
So, after you did this, you paste the code on the right and it will work. But how does it work?
The first line, Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) defines when the code will be executed. As you asked, it is on double click. If you want to change the trigger (Like in a button, for example), it's here you need to change.
The second line checks for the valid range of action. It checks if the Rangeis between Cells(2,16)
, which means Cell at Row 2 and Column 16 AKA P2and Cells(Cells(Rows.Count, 16).End(xlUp).Row, 16). This second part is weird because you mentioned "Go forever". So, instead of saying a specific row, like I did with row 2 on the first part, it now checks which is the last row of columns 16. The specific to get the last row is Cells(Rows.Count, 16).End(xlUp).Row, basically meaning this part of the range is Cell at last row and Column 16, AKA P..something
Since now we have our range of action, we need to make what you want, right? Adding them together. Which is line 3. Selection.Value returns the value of the cell you selected with the first click. Remember this will only work if it is within the range defined at line 2.
Since you have the value, you say that Selection.Value = Selection.Value + Cells(Selection.Row, 15).Value, so it sets the value to itself + the cell at the same row (Selection.Row) at column 15 (Column "O").
After that, it sets the value of the Column "O"to empty with vbNullString. If you want, you could replace it with 0, so this would also work.
And that's it. I just kindly ask for some research and some tries before asking for code. It is ok to get stuck. It is ok to not know how to do things. Don't feel afraid to ask for help. Just show some code next time.

The solution listed below applies simplified logic: as User enter the value in any cell in column O, this code will update column P (e.g. P3.Value =O3.Value + P3.Value) and then clear the content of the cell in column O (O3 in this example)
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
If Target.Column = 15 Then
Range("P" & Target.Row).Value = Target.Value + Range("P" & Target.Row).Value
Application.EnableEvents = False
Target.Value = ""
Application.EnableEvents = True
End If
End Sub
In this case you do not need any button or double_click event handler. Hope this may help

Related

Counting the number of times a value has changed within a cell

I'm evaluating a column of cells, for example A:A, and every time a value within a cell changes (not including the initial value), I want to be able to log the change to the appropriate cell of another column, say B:B.
The following is a pair of before and after screenshots demonstrating what is required:
A2has been updated once, so B2 should show a count of 1 and A6 has been updated twice, so B6 should show 2.
A similar solution can be found here, however this only applies to one cell:
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$A$1" Then [A2].Value = 1
End Sub
Cell values aren't connected to different sheets and can be hard coded.
None of the solutions in your link are both particularly good and comprehensive enough to modify, in my opinion, so I will be posting a better one.
Also your requirements are also not quite specific enough, so I've made up a few extra ones.
Assumptions:
All the A:A cell values start off empty. (Can be trivially modified to allow non-empty initial values.)
An edit of a cell that results in the same value is still considered a "change". This would normally also include where the cell was initially empty, but my code specifically excludes this edge case.
The "initial" value is the value after the first "change" to the cell. (Can be trivially modified to allow the initial value to be "empty", if that is the actual requirement.)
This is the relatively simple code:
'============================================================================================
' Module : <The appropriate sheet module>
' Version : 1.0
' Part : 1 of 1
' References : N/A
' Source : https://stackoverflow.com/a/47405528/1961728
'============================================================================================
Option Explicit
Private Sub Worksheet_Change _
( _
ByVal Target As Range _
)
Const s_CheckColumn As String = "A:A"
Const s_CountColumn As String = "B:B"
If Intersect(Target, Range(s_CheckColumn)) Is Nothing Then Exit Sub
Dim rngCell As Range
For Each rngCell In Intersect(Target, Range(s_CheckColumn))
With Range(s_CountColumn).Cells(rngCell.Row)
.Value2 = IIf(.Value2 <> vbNullString, .Value2 + 1, IIf(rngCell.Value2 <> vbNullString, 0, vbNullString))
End With
Next rngCell
End Sub
This solution correctly allows for multiple cells to be edited simultaneous, as happens when you do a multi-cell delete/paste or a fill.
Notes:
The initial "change" results in a count of 0. If you wish to hide these zeroes, set a custom number format of #;; for the count column.
The code can be modified to stop a "same value" edit from counting as a "change". One of the simplest ways of doing this is to use an extra column to store the old values.
Caveats:
Undo will no longer work correctly. This can be rectified, but it is not trivial to do so.
Pressing an ESC after starting an edit is required to cancel the edit and not trigger an update.
Put this in your worksheet code after you've entered the initial values, or add code to check if this is the initial value or not.
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("A:A")) Is Nothing Then
Range("B" & Target.Row) = Range("B" & Target.Row) + 1
End If
End Sub

Insert variable string into formula

Been working on this for a while, and can't seem to figure it out. I feel like I'm almost there, thanks to different posts in here. Here is what I am trying to do:
I have a dependent list that I would like to change to it's first value based on the selection of the first list. I found a code here, that I modified to work for my sheet, but I had to change all the names in the first list to conform to the Define Name rules(ie. no spaces). This works, and I can leave it at that, but I would prefer to have the spaces in my list. Whenever I use the formulas I was using to change the name shown in the list, the VBA script no longer works. I feel that it is because it is not seeing a change in the target cell, although the value is changing, the formula in the cell is not. Is that an accurate statement? If so, what can I change to make it work the way I want it to? Right now, the dependent list is running off =INDIRECT("$B$5) but I would like it to run off =INDIRECT('Store Data'!$A$23) which contains a VLOOKUP formula.
Here is the VBA script I am using now:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng(1) As Range, rng1 As Range
Set rng(0) = Range("B5") 'your primary selection
Set rng(1) = Range("G5") 'your secondary selection range
Application.EnableEvents = False
If Not Intersect(Target, rng(0)) Is Nothing Then 'if you have changed your primary selection
For Each rng1 In rng(1) 'each cell in your secondary selection
i = i + 1
rng1 = Worksheets("SD Names").Range("" & rng(0).Value2)(i, 1) 'gets changed to the nth value in the indirect reference of the primary selection ("TeamA" 's second row is "MemberA2" for example)
Next
End If
Application.EnableEvents = True
End Sub
Hope this is enough detail, thank you for any help!

copy row to next free row on another spreadsheet on change

First off, I'm a noob when it comes to Macros and VBA, so please forgive me if I don't make sense.
I've got an Excel spreadsheet which is basically a list of users and their mobile phone numbers and some other bits (columns A-K are currently used) and it's ordered by rows.
What I need is a way of copying the whole row if I change a cell. So if I change the username, it copies the whole row of that user to the next blank row on a second sheet.
The purpose of this is to keep an audit trail allowing us to see who's previously used a number etc.
I found this: Copy row to another sheet in excel using VBA which is working as intended, but I can't for the life of me get it to a, copy the cells to the next free row, or b, not overwrite the existing entry.
This is the code I'm using:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim a As Range, rw As Range
For Each a In Selection.Areas
For Each rw In a.Rows
If rw.Row >= 2 Then
rw.EntireRow.Copy Sheet2.Cells(2 + (rw.Row - 2) * 3, 1)
End If
Next rw
Next a
End Sub
I'd really appreciate it if someone could help me customise it.
I'm using Excel 2010 on Win7.
Many thank in advance.
Typically the Intersect method is used to determine if the cell or cells receiving a change involve one or more columns that you are concerned with. You can add additional parameters; in this case, I've .Offset the Worksheet.UsedRange property down one row to make sure that row 1 is not involved.
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Columns(1), Me.UsedRange.Offset(1, 0)) Is Nothing Then
On Error GoTo bm_Safe_Exit
Application.EnableEvents = False 'not really necessary in this case but never a bad idea within a Worksheet_Change
Dim a As Range
For Each a In Intersect(Target, Columns(1), Me.UsedRange.Offset(1, 0))
If CBool(Len(a.Value2)) Then _
a.EntireRow.Copy _
Destination:=Sheet2.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0) 'not really sure this is the correct destination
Next a
End If
bm_Safe_Exit:
Application.EnableEvents = True
End Sub
I've included a call to disable event handling for the duration of the Worksheet_Change event macro. While this is a critical step when the Worksheet_Change modifies values, it is not really important to incorporate here. However, it does not harm and is already in place in case you want to augment the Worksheet_Change to include something like a timestamp that would change the values on the worksheet.

Intersect not working if target range gets bigger

I am relatively new to VBA and I need help with this please.
I have a private sub within a sheet and I want it to autofill formulas adjacent to a dynamic named range, if the size of the range changes.
(edit) I am pasting data from another worksheet into this one columns A-M. My dynamic range is defined as =OFFSET($A$1,1,0,COUNTA($A:$A)-1,13). The first If statement should exit the sub if there is no data in column M and I had the destination calculating the last row of column M because I want to fill the formulas in N:O so that they cover the same number of rows as column M.
This is my code and it works if the size of the range gets smaller (i.e. if I delete rows from the bottom), but not if it gets bigger and I can't work out why!
Private Sub Worksheet_Change(ByVal Target As Range)
If Me.Range("M2").Value = "" Then
MsgBox "No Data!"
Exit Sub
Else
If Intersect(Target, Me.Range("rngOracleInvoices")) Is Nothing Then
Application.EnableEvents = False
Dim Lrows As Long
Lrows = Me.Cells(Me.Rows.Count, "N").End(xlUp).Row
Me.Range(Me.Cells(3, 14), Me.Cells(Lrows, "O")).ClearContents
Me.Range("N2:O2").AutoFill Destination:=Me.Range("N2:O" & Me.Range("M" & Me.Rows.Count).End(xlUp).Row)
End If
End If
Application.EnableEvents = True
End Sub
I put the last bit into a separate macro to test if it works on its own and for some reason, when I run it, the autofill goes all the way up to row 1 and overwrites the formulas, which is weird because I use that code a lot and it's never done that before. What have I done??!!
Also, if there is a better way to do the autofill I'd appreciate if someone could let me know what it is because I just cobbled that together from bits I found on forums :)
Thanks,
Soph
In this line Me.Range("N2:O2").AutoFill Destination:=Me.Range("N2:O" & Me.Range("M" & Me.Rows.Count).End(xlUp).Row) you calculate your last row on the column M so if it is empty it'll give you 1 and autofill your formula on row 1.
So start by calculating it on the good column (my guess is O)
You can also simply define an Integer variable to test it and if it is inferior to 2, change it back to 2, 3, 4 or whatever you want.
For your dynamic range, we might need some precision.
And for the AutoFill, you could just select manually the range N2:02 and then double-click on the bottom right square (the one you drag to autofill) and it'll autofill as long as there data in adjacent cells! (give it a try ;) )

Excel date formatting error

I'm doing some work on an already done excel program, but I'm very rusty in this area or probably never had done something in this part, I'm very new in VBA so please don't judge me if it's a simple mistake or error the links are in the description.
So I have problem where if I put the confirmation option, for example: in one cell press "1" in the product you have, and in another cell write "S" if you already have the product and it puts you a date of today in another cell.
The problem is when I delete the info that I inserted, and reenter it the date deformats itself becoming smaller and the location on the cell changes too.
I'm going to put the links because, like I said I'm rusty and I can't find where the code of this date comes.
http://www.docdroid.net/12dh4/master-atual-20155.xls.html -->This one is the Excel
http://www.docdroid.net/12dhj/errorphotos.pdf.html --> photos showing error
this is the code of one of the sheets the other ones are almost the same, If you guys see the photos it would help to understand the error itself.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng1 As Range
Set rng1 = Intersect(Range("v3:v500"), Target)
If rng1 Is Nothing Then Exit Sub
Application.EnableEvents = False
On Error Resume Next
If rng1.Value <> "" Then
rng1.Offset(0, 2).Value = Now()
Else
rng1.Offset(0, 2).Clear
End If
Application.EnableEvents = True
End Sub
The code would be triggered when you do the changes at column V. You may find the code in the worksheet itself:
it will clear the date if the column V contains no value.
By the way, the date is not getting smaller but it show the date of today in different format. you may check the date format by right click the cell and choose the format cells... option to look at it.