I try to write a macro that on double click of a cell, inserts a new row below that cell with some formulas. The important thing for me is that if I double click the cell again, then the formulas of the previously inserted line are updated with the right indexes.
For example, in the code below, double click A1 will insert the formula =B2+1 in line 2. Double clicking again should insert the same in line 2. But now line 2 shifter to line 3, so the formula in A3 should be =B3+1.
Here is the code I have so far:
Option Explicit
Const MYRANGE As String = "A:A"
Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
'If Sh.Name <> "Sheet1" Then Exit Sub
If Target.Cells.Count > 1 Then Exit Sub
If Intersect(Target, Sh.Range(MYRANGE)) Is Nothing Then Exit Sub
Cancel = True
Target.Rows(2).Insert
Dim newRow As Range
Set newRow = Target.Rows(2)
Dim rowIndex As Long
rowIndex = newRow.row
newRow.Cells(1, 1).Formula = "=B" & rowIndex & "+1"
End Sub
UPDATE: Changing Target.Rows(2).Insert to Target.Offset(1).EntireRow.Insert solves the issue. Leaving the question open for explanations on what is Offset and how it differs from Rows (The property EntireRow does not exist for Rows(2))
You can reduce this code by four lines for the same outcome, pls see below
Note though that your code is updating cells in your target row and below, ie it won't be updating any cell formulae outside column A that reside above your target. Which is probably not an issue but worth mentioning. If you wanted a full update then you would always insert at row2 rather than at target
Option Explicit
Const MYRANGE As String = "A:A"
Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
If Target.Cells.Count > 1 Then Exit Sub
If Intersect(Target, Sh.Range(MYRANGE)) Is Nothing Then Exit Sub
Cancel = True
Target.Offset(1).EntireRow.Insert
Target.Offset(1).Formula = "=B" & Target.Row + 1 & "+1"
End Sub
Related
I want to run a Worksheet_change function that will collect the cell references of any changed cells into an array of "Cells" objects but I keep getting the error "Type mismatch". This is what i've got so far:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim arArray(1 To 70) As Range
Dim K As Integer
K = 1
For i = 1 To 70
For j = 2 To 14
If Target.Column = j And Target.Row = i Then
Set arArray(K) = Target.Address
K = K + 1
End If
Next j
Next i
End Sub
Currently the code looks for any changes within the grid B1 to N70 and stores the changed cell if a change has occurred to a cell within that grid.
Any help would be greatly appreciated.
Right now, your code is set to look over many cells every time any cell changes. Based on your initial description, I'm sure that this is not what you really want. In the following code, Worksheet_Change keeps track of each cell that gets changed in B1:N70 by putting its address in a collection named "changed_cells". While "show_changes" prints the address of the cells that got changed to the immediate window.
Option Explicit
Dim changed_cells As New Collection
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Range("B1:N70"), Target) Is Nothing Then
changed_cells.Add Target.Address(False, False)
End If
End Sub
Private Sub show_changes()
Dim x As Long
For x = 1 To changed_cells.Count
Debug.Print changed_cells(x)
Next
End Sub
Note: If the immediate window is not visible, press ctrl+g to see the ouptut
You declared an array of Range objects at the top and the Target.Address property returns a string.
Your line
Set arArray(K) = Target.Address
Should be
Set arArray(K) = Range(Target.Address)
I'm trying to make hyperlinks in the first column on the condition that value in the cell begins with 'W'.
It seemed to work until I moved the script from Sheet object to ThisWorkbook.
Since then when I try to copy some cells from another worksheet and paste them to active worksheet, everything what I copied is pasted as hyperlink, no matter what column or value it is. What's more, if I try to type anything in the row where the first cell is linked, the default typing mode is in the hyperlink style.
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim KeyCells2 As Range
Set KeyCells2 = Range("A:A")
If Not Application.Intersect(KeyCells2, Range(Target.Address)) _
Is Nothing Then
On Error Resume Next
If Target.Count = 1 Then 'this one was meant to be a fix but it didn't change a thing
If Left(Target.Value, 1) = "W" Then
link = "http://<mylink>" & Target.Value
ActiveSheet.Hyperlinks.Add Target, link
End If
End If
End If
End Sub
Try this, I think it will do what you need:
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim KeyCells2 As Range
Dim targetcell As Range
Set KeyCells2 = Application.Intersect(Sh.Range("A:A"), Target, Sh.UsedRange)
If Not KeyCells2 Is Nothing Then
For Each targetcell In KeyCells2
If Left(targetcell.Value, 1) = "W" Then
link = "http://my.link." & targetcell.Value
Sh.Hyperlinks.Add Anchor:=targetcell, Address:=link
End If
Next
End If
End Sub
I have a set of data:
I have data validation set up for entering Y or N within the "more issues Column".
I need a row to be inserted under that when Y is selected, without having to run a macro.
I am running Excel 2016.
Try this macro: place in the worksheet object.
*Updated
Private Sub Worksheet_Change(ByVal Target As Range)
'If the cell already has a capital "Y" and you
'double click the cell it will insert a row.
'And typing a "Y" into any other column will not error
If Target.Cells.Count > 1 Then Exit Sub
If Not Intersect(Target, Columns(2)) Is Nothing Then
If Target.Value = "Y" Then
Target.Offset(1).EntireRow.Insert Shift:=xlDown
End If
End If
End Sub
Here's some working code to get you started. Just place the code in the sheet you are using by right clicking the sheet tab and selecting view code.
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim r As Range, sh As Worksheet
Set sh = ThisWorkbook.Sheets("Sheet1")
If Not Application.Intersect(Range("B2:B8"), Range(Target.Address)) Is Nothing Then
Set r = Target
If r = "Y" Then r.Offset(1, 0) = "populated cell"
End If
End Sub
The animated gif (click to see detail) show entering N or Y and having the cell below only Y's populated. Ask if you have questions about how this works.
I want to run a common macro when I double click on any of the cells of my excel sheet.
Say when I double click the cell A20, my macro will capture the column number & row number.
And for this intersection of column & row proceed with my next step.
The macro is as below for e.g:
Sub Trial()
Dim x, y As Integer
x = ActiveCell.Column
y = ActiveCell.Row
Dim input1, input2 As String
input1 = Range(x & "2").Value
input2 = Range("A" & y).Value
End Sub
The result will be used in another macro for calling a SQL query -
Select Sum(value)
From Table
Where
column1 = 'input1' and
column2 = 'input2'
I just need the step to how to call my macro when I double click on any of the cell.
Right-click the sheet tab and choose View Code.
Select Worksheet from the first (Object) drop-down list at the top of the window, and select BeforeDoubleClick from the second (Procedure) drop-down. This generates a procedure stub:
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
End Sub
It is in here that you can write your code. You can check the Target to only respond to a certain range of cells, and use Cancel to cancel any default double-clicking behaviour.
For example, the following will confirm which range was double-clicked:
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
MsgBox Target.Address
End Sub
Try using:
Option Explicit
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
MsgBox "Row:" & Target.Row & vbNewLine & "Column:" & Target.Column
End Sub
Image:
I have a table of customer data in Excel that can be added/edited using a VBA userform. Therefore I would like to highlight the row that has just been added/edited. This is my first time using VBA so I searched and found code from here:
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
If Target.Value <> "" Then
Target.Interior.ColorIndex = 6
End If
End Sub
which works perfectly fine but the highlights for the previous edits/add-ons are still there. I just want the last one to be highlighted.
Use a variable. Store the range in that when you are changing the color. Next time remove the color from that range.
Is this what you are trying?
Dim prevRng As Range
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim aCell As Range
If Not prevRng Is Nothing Then prevRng.Interior.ColorIndex = xlNone
Set prevRng = Target
For Each aCell In Target
If aCell.Value <> "" Then aCell.Interior.ColorIndex = 6
Next aCell
End Sub
This will handle multiple cells as #Pᴇʜ mentioned in the comment.
Here is some code that could work for you:
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
'Removing old conditional formatting if it exists already
Conditions = ActiveSheet.Cells.FormatConditions.Count
For i = 1 to Conditions
If ActiveSheet.Cells.FormatConditions(i).Type = 2 Then
If ActiveSheet.Cells.FormatConditions(i).Formula1 = "=1" Then ActiveSheet.Cells.FormatConditions(i).Delete
End If
Next i
'Adding new conditional formatting rule to the edited range
Target.EntireRow.FormatConditions.Add Type:=xlExpression, Formula1:="=1"
Target.EntireRow.FormatConditions(1).Interior.ColorIndex = 6
End Sub
Currently it will highlight all the last edited rows in all sheets. Not sure if this is what you wanted.
It will keep colored cells in your sheet intact when a new range has been changed.
It will keep other conditional formatting rules intact.
It highlights the last edited range, even if the range has been cleared!