I have 2 sheets List and Comments.
List is auto updated from another sheet that imports and formats data
I want to keep track of how often we use each object in sheet List by double clicking on the ID cell (Range("List!$B$6:$B$22")) but as the data is always changing the ID's move around.
the Comments which is a list of all possible ID's and its comments but not the imported values would be a good place to store count data and last used date.
Private Sub WorkSheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If InRange(Target, Range("List!$B$6:$B$22")) Then
Set c = Worksheets("Comments").Range("$A$2:$A$500").Find(Target.Value)
If Not c Is Nothing Then
Set c.Offset(0, 1) = c.Offset(0, 1) + 1
Set c.Offset(0, 2) = Date
End If
End If
Cancel = True
End Sub
No need to Set
Private Sub WorkSheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Not Intersect(Target, Range("$B$6:$B$22")) Is Nothing Then
Set c = Worksheets("Comments").Range("$A$2:$A$500").Find(Target.Value)
If Not c Is Nothing Then
c.Offset(0, 1) = c.Offset(0, 1) + 1
c.Offset(0, 2) = Date
End If
End If
Cancel = True
End Sub
Related
I make an Excel file that I use to import on a website. However, the values displayed mean nothing to the website, it needs IDs, but it's just not user-friendly. To help my users I said to myself I'll make a drop-down list that will change the value. For example, if you click on Switzerland, it will show 1 in the cell.
I have created one Macro based on the instruction on https://www.extendoffice.com/documents/excel/4130-excel-drop-down-list-show-different-value.html
'Updateby Extendoffice
Dim xRg As Range
selectedNa = Target.Value
If Target.Column = 3 Then
Set xRg = ActiveWorkbook.Names("Dropdown_cantons").RefersToRange
selectedNum = Application.VLookup(selectedNa, xRg, 2, False)
If Not IsError(selectedNum) Then
Target.Value = selectedNum
End If
End If
End Sub
For the first column it's ok
For my second collone with the cities this time, I thought I would change the collone numbers and follow the instructions in the link above. Maybe I can't put two macros in one Excel?
I tried to do it as a module, but it doesn't work for the second collone either. Do you have an idea?
Could look something like this:
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.CountLarge > 1 Then Exit Sub 'only handle single-cell changes
Select Case Target.Column
'depending on the column number, call `SetId` with specific arguments
Case 3: SetId Target, ActiveWorkbook.Names("Dropdown_cantons").RefersToRange, 2
Case 4: SetId Target, ActiveWorkbook.Names("Dropdown_countries").RefersToRange, 2
End Select
End Sub
'translate a data validation drop-down "text" selection into a matching "id" value
Sub SetId(c As Range, rngTable As Range, returnCol As Long)
Dim v, res
v = c.Value
If Len(v) > 0 Then
res = Application.VLookup(v, rngTable, returnCol, False) 'find the id
If Not IsError(res) Then 'got a match
On Error GoTo haveError 'ensure we exit with events back on
Application.EnableEvents = False 'disable events
c.Value = res 'switch the value
Application.EnableEvents = True 're-enable events
End If
End If
Exit Sub 'normal exit
haveError:
Application.EnableEvents = True 'just in case....
End Sub
I have a cell A1 which extracts values from a server every n seconds, however using the macro below (which is currently used) is not suitable:
Dim preVal As String
Dim count As Integer
'Intention is if cell A1 changes, record changes to Column C and Column D
Private Sub Worksheet_Change(ByVal Target As Range)
If Target = Range("A1") Then
Call cellchange(Range("A1"))
End If
End Sub
Private Sub cellchange(ByVal a As Range)
'If row is empty, filled into that row, if not skip to next one
If a.Value <> preVal Then
count = count + 1
'copy the value of A1 from sheet 1
preVal = Sheets("Sheet1").Range("A1").Value
Cells(count, 4).Value = a.Value
'copy the values of time of which data change detected
Cells(count, 3) = Now()
End If
End Sub
In a simplest way, the cell A1 will be updated every few seconds from a server, so I need the macro to be updated/trigger when it detects changes in cell A1 that are not from human input.
You need to use something that really checks if your target cells is updated. usually application.intersect are used. Here I am using address property.
Dim preVal As String
Dim count As Integer
'Intention is if cell A1 changes, record changes to Column C and Column D
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.address = Range("A1").address Then
cellchange target
End If
End Sub
Private Sub cellchange(ByVal a As Range)
'If row is empty, filled into that row, if not skip to next one
If a.Value <> preVal Then
count = count + 1
'copy the value of A1 from sheet 1
preVal = Sheets("Sheet1").Range("A1").Value
Cells(count, 4).Value = a.Value
'copy the values of time of which data change detected
Cells(count, 3) = Now
End If
End Sub
Hope it helps.
Regards,
M
I'm fairly new to VBA and looking for any advice on how to manually control the change event for the below.
Column "F" has a Vlookup that returns "Fail" or "0", and rather that having each individual code to hide the row when the single cell in column F changes to 0, I found the below to work the best.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim myRow As Long
If Target.Column = 6 Then
' Loop through rows 5-160
For myRow = 5 To 160
' Hide row in entry in column F is "0"
Rows(myRow).Hidden = (Cells(myRow, "F") = "0")
Next myRow
End If
End Sub
I have tried to use the below with the event change but it crashes the program and always restarts. Any suggestions would be greatly appreciated.Thanks!
Private Sub Worksheet_Calculate()
Worksheet_Change Range("F:F")
End Sub
This is my version of what you are trying to accomplish. If the values returned by the formulas in F5:F160 change, the changed values are caught by Worksheet_Calculate and only those changed values are processed by Worksheet_Change.
Caveat: This method of capturing changed values from formulas does not work well when volatile functions are in the workbook. Volatile functions include TODAY(), NOW(), OFFSET(...), etc.
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("F5:F160")) Is Nothing Then
Application.EnableEvents = False
On Error GoTo meh
Dim t As Range
Debug.Print "chg: " & Intersect(Target, Range("F5:F160")).Address(0, 0)
For Each t In Intersect(Target, Range("F5:F160"))
't.EntireRow Hidden = CBool(LCase(t.Value2) = "fail" or t.Value2=0)
t.EntireRow.Hidden = CBool(LCase(t.Value2) = "fail")
Next t
End If
meh:
Application.EnableEvents = True
End Sub
Private Sub Worksheet_Calculate()
Static effs As Variant
Dim f As Long, t As Range
If IsEmpty(effs) Then
effs = Range("F1:F160").Value2
For f = 5 To 160
If IsError(effs(f, 1)) Then effs(f, 1) = vbNullString
Next f
Else
For f = 5 To 160
If Not IsError(Cells(f, "F")) Then
If effs(f, 1) <> Cells(f, "F").Value2 Then
If Not t Is Nothing Then
Set t = Union(t, Cells(f, "F"))
Else
Set t = Cells(f, "F")
End If
effs(f, 1) = Cells(f, "F").Value2
End If
End If
Next f
If Not t Is Nothing Then
Debug.Print "calc: " & t.Address(0, 0)
Worksheet_Change t
End If
End If
End Sub
This seems to run well on a test workbook. Additional error and looping control may be necessary in your own situation.
I am using a macro to write a datestamp when a column is modified. The idea is that whenever the status changes it gives the running time for that particular status. I have four columns:
A b c d
clearing 24.04.2015 1 empty
**when stauts is changed**
A b c d
wait for start 24.04.2015 2 24.04.2015
formual for c is :
IF(RC[-2]="";"";IF(RC[-2]="clearing";1;2))
Macro;
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 1 And Target.Value = "clearing"
Then
Cells(Target.Row, 2) = Date
Else
If Target.Column = 3 And Target.Value = 2
Then
Cells(Target.Row, 4) = Date
End If
End If
End Sub
The problem is when C column is, with the help of formula, changed to 2 the macro does not automatically give me the date, but when I insert that manually it's working.
When you put values into the worksheet that is triggering the Worksheet_Change event macro, you should always turn off events or the macro will try to run on top of itself.
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Columns(1)) Is Nothing Then
On Error GoTo Fìn
Application.EnableEvents = False
Dim rng As Range
For Each rng In Intersect(Target, Columns(1))
If LCase(rng.Value) = "clearing" Then
Cells(rng.Row, 2) = Now
Cells(rng.Row, 2).NumberFormat = "dd.mm.yyyy"
'Cells(rng.Row, 3).FormulaR1C1 = "maybe put the formula in here"
ElseIf rng.Offset(0, 2).Value = 2 Then
Cells(rng.Row, 4) = Now
Cells(rng.Row, 4).NumberFormat = "dd.mm.yyyy"
End If
Next rng
End If
Fìn:
Application.EnableEvents = True
End Sub
It sounds like you already have that formula in column C but I left a place where you can put it in once column A gets the clearing value. Another option would be to simply write a 1 into column C and the next time write a 2 in column C. That way you wouldn't have to deal with the formula at all.
Got a workbook with two sheets in it. The first is where the data is, and the second has been set up as a "corrections" page. This workbook is sent out to users who are to review it and note inconsistencies/discrepencies. Right now it's set up to highlight the cell via double-click then forward the active cell to a cell at the end of the same row. As it turns out people want more room for comments so I've decided to go with a second sheet that works as a comments sheet. I've got the userform and everything with it done except the "submit" button. When the user double-clicks now the cell is still highlighted, but instead of forwarding to the end of row it opens the user form for comments. I'm trying to get the submit button to do two things:
First, I want it to place the row# of the cell that was highlighted into the first column; and second, I want what the user puts in the textbook to be placed into the second column.
I can get it to enter a value in the first row for the textbox, but I don't know where to start for the row#'s (maybe ActiveCell.Row ?); also, I don't know how to go about getting it set to move down to the next row if the first row already has comments in it (need something with a Row +1 I guess? It's just this one last button that's slowing me up; got the rest done, but I could use some advice on this part of the userform coding. Thanks!
Here's how I'd do it (rough draft):
Private Sub Worksheet_Beforedoubleclick(ByVal Target As Range, Cancel As Boolean)
Const CLR_INDX As Integer = 6
If Target.Interior.ColorIndex = xlNone Then 'If cell is clear
With frmCorrections
Set .CellRange = Target
.HiliteColorIndex = CLR_INDX
.Show
End With
'Or Else if cell is already yellow
ElseIf Target.Interior.ColorIndex = CLR_INDX Then
Target.Interior.ColorIndex = xlNone 'Then clear the background
End If
Cancel = True
End Sub
and the user form code:
Dim m_rng As Range
Dim m_index As Integer
Public Property Set CellRange(rng As Range)
Set m_rng = rng
End Property
Public Property Let HiliteColorIndex(indx As Integer)
m_index = indx
End Property
Private Sub cmdCancel_Click()
Me.Hide
End Sub
Private Sub cmdOK_Click()
Dim cmt As String, NextCell As Range
cmt = Me.txtComment.Text
If Len(cmt) > 0 Then
Set NextCell = ThisWorkbook.Sheets("Corrections").Cells( _
Rows.Count, 1).End(xlUp).Offset(1, 0)
With NextCell
.Parent.Hyperlinks.Add Anchor:=NextCell, Address:="", _
SubAddress:=m_rng.Address(False, False, , True), _
TextToDisplay:=m_rng.Address(False, False)
.Offset(0, 1).Value = cmt
End With
m_rng.Interior.ColorIndex = m_index
End If
Me.Hide
End Sub
Private Sub UserForm_Activate()
Me.txtComment.Text = ""
Me.lblHeader.Caption = "Enter comment for cell: " & _
m_rng.Address(False, False)
End Sub
EDIT:
This is what I finally came up with to get it working the way I wanted. On the first worksheet the user can double click on the cell, which then highlights the cell and prompts with the user form. If the user cancels then the highlight is removed and the user can keep working; if they enter anything in the box and submit it then the cell addressis placed in one row on the "Comments" page and the text is enteredone column over in the row corresponding to the original cell's address so I can see where the correction is and what their justification was. Anyways the codes are below.
I use the following for highlighting and calling the form:
Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
Application.EnableEvents = False
Dim TargRow As Variant
Dim TargCol As Variant
TargRow = Target.Row
TargCol = Target.Column
Header = 8
FirstCol = 0
LastCol = 13
CommentCol = 13
If TargRow > Header And TargCol > FirstCol And TargCol < LastCol Then
'If the cell is clear
If Target.Interior.ColorIndex = xlNone Then
Cancel = True
'Then change the background to yellow
Target.Interior.ColorIndex = 6
Corrections.Show
'Else if the cell background color is already yellow
ElseIf Target.Interior.ColorIndex = 6 Then
'Then clear the background
Target.Interior.ColorIndex = xlNone
End If
End If
'This is to prevent the cell from being edited when double-clicked
Cancel = True
Application.EnableEvents = True
End Sub
And I use this for the user form itself:
Private Sub UserForm_Initialize()
TextBox.Value = ""
End Sub
Private Sub CommandButton2_Click()
Unload Corrections
ActiveCell.Interior.ColorIndex = xlNone
End Sub
Private Sub CommandButton1_Click()
Dim PrevCell As Range
Set PrevCell = ActiveCell
ActiveWorkbook.Sheets("Comments").Activate
Range("A6").Select
Do
If IsEmpty(ActiveCell) = False Then
ActiveCell.Offset(1, 0).Select
End If
Loop Until IsEmpty(ActiveCell) = True
ActiveCell.Value = PrevCell.Address
ActiveCell.Offset(0, 1) = TextBox.Value
Unload Corrections
ActiveWorkbook.Sheets("DataPage").Activate
End Sub