I have a column whose cells have comments via CommentsThreaded and CommentThreaded objects. In another column, I successfully copy the contents of these threads using the function =GetComments(A1), as shown below:
' Returns the concatenated string of parent and child comments for the specified input cell.
Function GetComments(SelectedCell As Range) As String
Set CellComment = SelectedCell.CommentThreaded
Dim Result As String
If Not CellComment Is Nothing Then
Result = CellComment.Author.Name & ": """ & CellComment.Text & """ " & vbNewLine & vbNewLine
Dim ChildCount As Integer
ChildCount = 1
For Each ChildComment In CellComment.Replies
Result = Result & "[Reply #" & ChildCount & "] " & ChildComment.Author.Name & ": """ & ChildComment.Text & """ " & vbNewLine & vbNewLine
ChildCount = ChildCount + 1
Next
Else
Result = "No Comments"
End If
GetComments = Result
End Function
Example output would be: John Doe: "My comment"
However, I've noticed that when a comment is added/edited/deleted, the output cell that uses the GetComments function is not updated. I have to manually re-run the function in the output cell to get its contents to update by selecting it and pressing Enter.
I've tried using all of the typical event handlers, such as Worksheet.Change, SelectionChange, etc. None of the events fire when a comment is modified. Neither does manually forcing Volatile or Calculate. It's almost like the Add/Delete/Edit methods of CommentsThreaded are not included in workbook events at all.
Is this possible? Thanks!
Related
We have a macro that loops through a set of 50 workbooks that have different amounts of sheets. The sheets look similar but all have different sheet names.
We want to place a formula in the first sheet ("Framsida") that searches through column B in sheet 3 to the last sheet to identify how many unique entries there are.
We have been working with PRODUCTSUM and FREQUENCY.
The formula works when pasted into the sheet manually.
When trying this with the macro, it starts linking to other data sources with the error message
"This workbook contains links to other data sources".
The code we tried:
Worksheets("Framsida").Range("m5").Formula = "=SUMPRODUCT(--(FREQUENCY(''" & Sheets(3).Name & " : " & Sheets(Sheets.Count).Name & " '!$B$6:$b$200, ' " & ActiveWorkbook.Sheets(3).Name & " : " & ActiveWorkbook.Sheets(Sheets.Count).Name & " '!$B$6:$b$200)<>0))"
This is the result that comes out in sheet "Framsida" when running the macro:
=PRODUKTSUMMA(--(FREKVENS('8007029 :[ 8007062 ] 8007062 '!$B$6:$B$200; '8007029 :[ 8007062 ] 8007062 '!$B$6:$B$200)<>0))
Where PRODUKTSUMMA=PRODUCTSUM
and FREKVENS=FREQUENCY
It adds the last sheet name in square brackets and we have no idea why. We are open for suggestions to other solutions.
This is the entire loop:
Sub SummeringFramsida()
'Variabler för loopen
Dim MyFile As String
Dim Filepath As String
'-----------------------------------------------------------------------------------'
'Öppnar filer tills det att man kommer till Huvudfilen i listan, filerna som ska sökas måste alltså ligga ovanför i listan'
Filepath = "C:\Users\JohannaFalkenstrand\Desktop\Excelfix\"
MyFile = Dir(Filepath)
Do While Len(MyFile) > 0
If MyFile = "Huvudfil.xlsm" Then
Exit Sub
End If
Workbooks.Open (Filepath & MyFile)
Workbooks(MyFile).Activate
Worksheets("Framsida").Range("m5").Formula = "=SUMPRODUCT(--(FREQUENCY('" & Sheets(3).Name & " : " & Sheets(Sheets.Count).Name & " '!$B$6:$b$200, ' " & ActiveWorkbook.Sheets(3).Name & " : " & ActiveWorkbook.Sheets(Sheets.Count).Name & " '!$B$6:$b$200)<>0))"
'Stänger, sparar och går till nästa fil'
Workbooks(MyFile).Save
Workbooks(MyFile).Close
MyFile = Dir
Loop
End Sub
Give it a try with Range(...).Address(1,1,xlA1,1). This will give you a string of range reference that contains both the workbook and the sheet reference. Then you can compile the required formula with simple string manipulation, like
For Each wb in <SomeCollectionOfWorkbooks>
For Each sh in wb.Sheets
Debug.Print "Copy this to the required cell = SUM(" & _
sh.Range("B6:B200").Address(1,1,xlA1,1) & ")"
Next
Next
The key is the external reference parameter of .Address.
It looks like you want to use same range but on different sheets at same time, so you need to check this out:
Create a reference to the same cell range on multiple
worksheets
Applying this to your code this should kind of work:
Worksheets("Framsida").Range("m5").Formula = "=SUMPRODUCT(--(FREQUENCY(" & Sheets(3).Name & ":" & Sheets(Sheets.Count).Name & "!$B$6:$b$200," & ActiveWorkbook.Sheets(3).Name & ":" & ActiveWorkbook.Sheets(Sheets.Count).Name & "!$B$6:$b$200)<>0))"
Once every 3 months we make a file available for our engineers.
This Excel files, pulls data from an Access file and shows it in Excel format.
Since some of this data doesn't change, we don't know whether the engineers haven't looked at it or whether the value isn't changed. What i'm trying to implement is some sort of "confirmation" button so we know the value shown is actually confirmed.
What i'm trying to do is enter an extra column in our access file called "confirmation".
When we pull this data in our excel file, i'm trying to find a way to convert that "confirmation field" into a commandbutton so whenever the data gets pulled, a commandbutton shows up on every line. Whenever the button gets clicked, the data gets saved in our Access file so we know the line is actually confirmed.
Maybe there are some other , easier, ways to do this?
I currently have some code to save excel data in Access but its not working in its current form:
Sub S_SaveDataToDB()
If ActiveSheet.Name = "Estimate" Then
ViKey = 1
Else
ViKey = 2
End If
For i = 1 To ActiveSheet.ListObjects("TB_ACC" & ViKey).ListRows.Count
VsData = "SET [BE] = '" & F_FilterData(ActiveSheet.Cells(7 + i, 17)) & "', [PO STATUS] = '" & F_FilterData(ActiveSheet.Cells(7 + i, 18)) & "', [REMARKS] = '" & F_FilterData(ActiveSheet.Cells(7 + i, 19)) & "', [LOGDATE] = '" & Now() & "', [LOGID] = '" & Environ("Username") & "' WHERE [PO item] = '" & ActiveSheet.Cells(7 + i, 9) & "'"
If Len(F_FilterData(ActiveSheet.Cells(7 + i, 16))) + Len(F_FilterData(ActiveSheet.Cells(7 + i, 17))) + Len(F_FilterData(ActiveSheet.Cells(7 + i, 18))) > 0 Then Call S_UpdateDataInDB(VsData)
Next i
MsgBox "Data has been saved"
and
Sub S_UpdateDataInDB(VsData)
Dim cnDB As New ADODB.Connection
VsDBPath = ThisWorkbook.Sheets("Settings").Range("B2").Value
VsTable = "KCD"
cnDB.Open "Provider=Microsoft.ACE.OLEDB.12.0;" & "Data Source=" & VsDBPath & ";" & "Jet OLEDB:Engine Type=5;" & "Persist Security Info=False;"
cnDB.Execute ("UPDATE " & VsTable & " " & VsData)
cnDB.Close
End Sub
Differences here are:
I want to just save text ("Data confirmed") for that particular cell.
So if one wants to confirm data on Row 8 and clicks "Data confirm". It should only save "Data confirm" for row 8 in access.
Generally, when I'm trying to add a feature to every row in a column, I'll use a hyperlink. It fits neatly into the cell, it can be anchored to a specific cell, and it also shows when it's been followed (the color changes). I've mocked together some code as an example; try to adapt it to your application and let me know if you need help.
First, in a standard module, enter the following code to create the hyperlinks. Presumably, you'd embed this into the code that pulls the data.
Sub PullData()
Dim sh As Worksheet
Dim lastRow As Long
'Pull the data
' DO STUFF
'Identify the range of the pulled data
Set sh = Sheets("PulledData")
lastRow = sh.Range("A" & sh.Rows.Count).End(xlUp).Row
'Loop from row 2 through last row
For i = 2 To lastRow
'Assuming the 'save' option is in Column c
sh.Cells(i, "C").Hyperlinks.Add Anchor:=sh.Cells(i, "C"), Address:="", _
SubAddress:="", TextToDisplay:="Click To Save"
Next i
End Sub
Next, in the worksheet code for the sheet with the data, enter the below code. This tells the application what to do when a hyperlink is clicked. I created a fake function that is meant to mimic saving the data. You can change this as needed, or use a different design if it suits your needs better.
Private Sub Worksheet_FollowHyperlink(ByVal Target As Hyperlink)
'Confirm that this is a hyperlink in column 3
If Not Intersect(Target.Range, Columns(3)) Is Nothing Then
MsgBox SaveData(Target.Range)
End If
End Sub
Private Function SaveData(rng As Range) As Boolean
Debug.Print rng.Address & " has been saved."
SaveData = True
End Function
I am trying to find an email, by subject starting with specific text, to then download an attachment from that email.
I am using a variable with Restrict function, however issue seems to be because of usage of wildcards.
Sub findemail()
cntofmkts = Range("A" & Rows.Count).End(xlUp).Row
cntofmkts = cntofmkts - 1
ftodaydate = Format(Date, "yyyy-mm-dd")
Do
If i > cntofmkts Then Exit Do
MarketName = Range("A" & j).Value
Findvariable = "XXX_" & MarketName & "_ABC_" & ftodaydate
For Each oOlItm In oOlInb.Items.Restrict("[Subject] = *Findvariable*")
eSender = oOlItm.SenderEmailAddress
dtRecvd = oOlItm.ReceivedTime
dtSent = oOlItm.CreationTime
sSubj = oOlItm.Subject
sMsg = oOlItm.Body
If oOlItm.Attachments.Count <> 0 Then
For Each oOlAtch In oOlItm.Attachments
'~~> Download the attachment
oOlAtch.SaveAsFile NewFileName & oOlAtch.Filename
Exit For
Next
Else
MsgBox "The First item doesn't have an attachment"
End If
Exit For
Next
i = i + 1
j = j + 1
Loop
End sub
The first thing you should mind is that the Restrict() method does not evaluate the variable by it's name. You will have to concatenate the variable to the string.
Another one is, if you look at the example from MSDN site, you will see that there is not support for wildcards, so you will have to use the SQL syntax and the searched text in the filter expression must be between quotes.
' this namespace is for Subject
filterStr = "#SQL=""http://schemas.microsoft.com/mapi/proptag/0x0037001f"" like '%" & Findvariable & "%'"
It seems that urn:schemas:httpmail:subject also works and is easier to understand, but I can't confirm this now:
filterStr = "#SQL=""urn:schemas:httpmail:subject"" like '%" & Findvariable & "%'"
The string comparison that DASL filters support includes equivalence, prefix, phrase, and substring matching.
For Each oOlItm In oOlInb.Items.Restrict("[Subject] = Findvariable")
It looks like you are searching for the exact match. But what you need is to find a substring using the following syntax:
criteria = "#SQL=" & Chr(34) & "urn:schemas:httpmail:subject" & Chr(34) & " like '%question%'"
Note that when you filter on the Subject property, prefixes such as "RE: " and "FW: " are ignored.
See Filtering Items Using a String Comparison for more information.
P.S. The Restrict method is an alternative to using the Find method or FindNext method to iterate over specific items within a collection. The Find or FindNext methods are faster than filtering if there are a small number of items. The Restrict method is significantly faster if there is a large number of items in the collection, especially if only a few items in a large collection are expected to be found.
I have a function which sets a variable for the current user. The variable name is prefixed with the name of the module - basically, the way the application is set up, Client is a class, Server is a class, Agency is a class and so on. This is an attempt to create a system whereby we can find out any key information about a client or one of their websites, across over 200 servers, with as few clicks as possible and using live data from their DB.
The function is as follows:
public sub setVariable(varName, varValue)
varValue = cstr(varValue)
def = ""
if varValue = "" then def = "1"
response.write vbcrlf & "Variable: " & varName & " : " & varValue & vbcrlf
if not cstr("" & getVariable(varName, def)) = cstr("" & varValue) then
response.write vbcrlf & varName & " : " & varValue & vbcrlf
prepend varName, "Module." & Name & "."
response.write vbcrlf & varName & " : " & varValue & vbcrlf
session(varName) = varValue
Core.RunSproc "SetUserVariable", array("#name", "#value"), array(varName, cstr(varValue)), setVar
end if
end sub
Now on line 5, where it is first output, only "ID" is output as the variable name. However 2 lines later the name is set to "Module.<module-name>.ID" (for example Module.Server.ID. 2 lines after that, after the prepend statement (which acts the same as doing varName = "something" & varName), it outputs the something + "Module.<module-name>.ID". In effect, in this case, it outputs "Module.Server.Module.Server.ID". Note that if I take anything out, it is taken out of the first Module.Server but not the 2nd. Does anyone have any idea what is causing this? It seems as though Module.Server is being prepended to the variable name between lines 5 & 7, but the only line there is an if statement. Thanks in advance.
Seems I have found the answer. It's the fact that ASP automatically assumes variables input into functions are byref. Thus, when calling getVariable, I was actually prepending "Module.Server." there too, and because it was byref the variable maintained the value.
Regards,
Clarkey
So, I have Googled about and it seems that while making custom Pop up menus, if one wants to pass parameters then this is possible but for me comes with 2 major problems:
1) The function you call will execute, but you will not be able to activate a breakpoint on it, or even use Stop.
2) Oddly it seems to get called twice, which isn't very helpful either.
Code to illustrate ( please put in a module and not in a sheet )
Option Explicit
Sub AssignIt()
Dim cbrCmdBar As CommandBar
Dim strCBarName As String
On Error Resume Next
strCBarName = "MyNewPopupMenu"
'Delete it first so multiple runs can occur without appending
Application.CommandBars(strCBarName).Delete
' Create a menu bar.
Set cbrCmdBar = Application.CommandBars.Add(Name:=strCBarName, Position:=msoBarMenuBar)
' Create a pop-up menu.
strCBarName = "MyNewPopupMenu"
Set cbrCmdBar = Application.CommandBars.Add(Name:=strCBarName, Position:=msoBarPopup)
'DEFINE COMMAND BAR CONTROL
With Application.CommandBars(strCBarName).Controls.Add(Type:=msoControlButton)
.Caption = "MyMenu"
.OnAction = BuildProcArgString("MyProc", "A", "B", "C") 'You can add any number of arguments here!
End With
'DEFINE COMMAND BAR CONTROL
With Application.CommandBars(strCBarName).Controls.Add(Type:=msoControlButton)
.Caption = "Test No Args"
.OnAction = "CallWithNoArgs"
End With
Application.CommandBars(strCBarName).ShowPopup
End Sub
Sub CallWithNoArgs()
MsgBox "No Args"
End Sub
'FUNCTION TO BUILD PROCEDURE ARGUMENTS (You just have to plop this in any of your modules)
Function BuildProcArgString(ByVal ProcName As String, ParamArray Args() As Variant)
Dim TempArg
Dim Temp
For Each TempArg In Args
Temp = Temp + Chr(34) + TempArg + Chr(34) + ","
Next
BuildProcArgString = ProcName + "(" + Left(Temp, Len(Temp) - 1) + ")"
End Function
'AND FINALLY - THE EXECUTABLE PROCEDURE!
Sub MyProc(x, y, z)
MsgBox x & y & z
Debug.Print "arrgggh why won't the breakpoint work, and why call twice!!!!!!"
End Sub
If someone could help with this, that would be great. It seems another developer in the past hit the wall and so for the 5 items we have Method_1 ... Method_5 with the number passed into Method_Core(ByVal i As Integer) style. I think I will take this route too although very ugly, it works better than what I have mocked up below.
PS. This is a quick mockup so I don't expose proprietary code etc
You can use the .Parameter property. This is an example of a code in production (with only the lines of interest):
Dim i As Integer
Set cl = MainForm.Controls("classroomList")
For i = 0 To cl.ListCount - 1
With .Controls.Add(Type:=msoControlButton)
.Caption = cl.List(i)
.faceId = 177
.OnAction = "'" & ThisWorkbook.Name & "'!" & "assignClassroom"
.Parameter = cl.List(i)
End With
Next i
And the procedure could be something like:
Public Sub assignClassroom(Optional someArg as SomeType)
' code here
CommandBars.ActionControl.Parameter 'The parameter here
' more code here
End Sub
Don't ask me why this works, but it does. Source for this info is Using procedures with arguments in non-obvious instances
Sub AssignIt()
Const strCBarName As String = "MyNewPopupMenu"
Dim cbrCmdBar As CommandBar
'Delete it first so multiple runs can occur without appending
On Error Resume Next
Application.CommandBars(strCBarName).Delete
On Error GoTo 0
' Create a pop-up menu.
Set cbrCmdBar = Application.CommandBars.Add(Name:=strCBarName, Position:=msoBarPopup)
'DEFINE COMMAND BAR CONTROL
With Application.CommandBars(strCBarName).Controls.Add(Type:=msoControlButton)
.Caption = "MyMenu"
.OnAction = "'MyProc ""A"",""B"",2'"
End With
Application.CommandBars(strCBarName).ShowPopup
End Sub
Sub MyProc(x As String, y As String, z As Integer)
MsgBox x & y & (z * 2)
Debug.Print "AHA!!! the breakpoint works, and it's only called once!!!!!!"
End Sub
The key is to call the procedure in the .OnAction event surrounded by single quotes. Also, you need to escape your double quotes with double quotes. Numeric parameters need not be escaped.
The reason there are double calls and no break points is because of the parentheses (“( )”) surrounding the arguments in the .OnAction call:
.OnAction = BuildProcArgString("MyProc", "A", "B", "C")
Best guess: The parser for .OnAction chokes when these parentheses are used.
This should work:
.OnAction = "'BuildProcArgString" & chr(34) & "MyProc" & _
chr(34) & "," & chr(34) & "A" & chr(34) & "," & chr(34) & _
"B" & chr(34) & "," & chr(34) & "C" & "'"
Other Notes:
1) Single quotes, after the first double quote and before the last double quote, should be used to encapsulate the entire call.
2) Chr(34) is the ASCII character for double quotes (“). All data types (ints, longs, strings, etc.), and quoted commas need to be preceeded by a Chr(34). The one exception is the ending sinlge quote (" ' "). Example:
.OnAction = "'m_Test" & Chr(34) & 100 & Chr(34) & "," & Chr(34) & _
intVariable & Chr(34) & "," & Chr(34) & "String" & Chr(34) & _
"," & Chr(34) & stringVariable & "'"
The function called:
Public Function m_Test(i as Integer, iVar as Integer, s as String, sVar as String)
3) .OnAction does not seem to pass Arrays or Objects. An item in an array can be passed (e.g. .OnAction = "'myTest" & Chr (34) & Args(0) & "'"), but not the entire Array (e.g. .OnAction = "'myTest" & Chr (34) & Args & "'"). Object pointers can be passed (ref: http://www.access-programmers.co.uk/forums/showthread.php?t=225415). But I've had no success in passing pointers to arrays.
4) The .OnAction used in the original example is not surrounded by quotation marks so the .OnAction call is made when AssignIt() gets called but before the popup menu pops up.