I found an old solution made by a user named n1ghthawk (2012!), using shapes to form a flowchart that can be filtered by selected shape(s).
Exactly what I need except that the code fails in a certain scenario with connectors. I have failed to fix this myself, so I would appreciate if someone could help me.
I will send a link to the file to respondents instead of posting code, as I think that will make it much easier to help. In the file, I have setup the shapes to show the failing scenario in the simplest possible form.
Thanks John, for helping out.
A collegue of mine just pointed me in the right direction and these 3 lines stopped an infinite loop and made the script move on the the next shape, fixing the failing scenario:
For j = 1 To UBound(MyNames())
If thisshape.Name = MyNames(j) Then Exit Sub
Next
So the entire recursive Sub looks like this now:
Sub Get_LegUp(thisshape As Shape)
Dim con As Variant
Dim i As Long
Dim j As Integer
Dim dependentshape As Shape
'***
For j = 1 To UBound(MyNames())
If thisshape.Name = MyNames(j) Then Exit Sub
Next
'***
namecount = namecount + 1
MyNames(namecount) = thisshape.Name
For i = 1 To shpconlist.Item(thisshape.Name).up.Count
con = shpconlist.Item(thisshape.Name).up(i)
namecount = namecount + 1
MyNames(namecount) = con
Set dependentshape = ActiveSheet.Shapes(con).ConnectorFormat.BeginConnectedShape
Get_LegUp dependentshape
Next i
End Sub
If someone wants the code to recreate the functionality, just post back here and I will put it all in here.
Again, apologies for not following guidelines.
Related
New to VBA, I am successfully importing and reading a Task List and Resources from Excel, executing VBA in Excel and inserting these records into MS Project. I am looking at setting the ActiveProject.Resources.Standardrate = "100p/h", however I am getting an error.
The code being applied (credit to previous answers provided to other related questions on Stackoverflow for the following code).
If Not ExistsInCollection (newproject.Resources, strResource) Then
newproject.resources.add.name = StrResource <-- This works, resources are added.
' However, inserting the following line:
newproject.resources.standardrate = "100p/h" <-- It errors here
End if
Any assistance is greatly appreciated - Thank you.
The code needed a minor modification to get a reference to the newly-added resource so that the StandardRate can then be updated.
This code also demonstrates how to handle the case of a list of comma-delimited resources rather than a single one.
Dim t As Task
Set t = NewProject.Tasks.Add("New task 1")
Dim StrResource As String
StrResource = "Resource 1,Resource 2,Resource 3"
Dim arrRes As Variant
arrRes = Split(StrResource, ",")
Dim i As Variant
For Each i In arrRes
If Not ExistsInCollection(NewProject.Resources, i) Then
Dim r As Resource
Set r = NewProject.Resources.Add(i)
r.StandardRate = 100
End If
t.Assignments.Add , ActiveProject.Resources(i).UniqueID
Next i
I am new to Excel VBA. I have written some code with the help of online videos but I am stuck to resolve a problem of selecting two cells as Range values separated by commas. However, If I just use one of the selected cells, the compiling error does not occur.
Sub elevation_finder()
Dim elevation As Long
Dim ieobject As InternetExplorer
Dim htmlElement As IHTMLElement
Dim i As Integer
i = 1
Set ieobject = New InternetExplorer
ieobject.Visible = True
ieobject.navigate "https://www.freemaptools.com/elevation-finder.htm"
Application.Wait Now + TimeValue("00:00:05")
ieobject.document.getElementById("locationSearchTextBox").Value = ActiveWorkbook.Sheets("Header").Range("C2").Value
End Sub
My next step after entering the numbers (coordinates as integers) is to import the result back into new column.
Help and suggestion is appreciated to improve the code in automating the coordinates to find respective elevations.
enter image description here
Kind regards.
Should be able to use something like:
With ActiveWorkbook.Sheets("Header")
ieobject.document.getElementById("locationSearchTextBox").Value = _
.Range("B2").Value & "," & .Range("C2").Value
End with
I need to change the status and write comments for about 100 lists in SharePoint every week. I tried to automate it. I know how to open them in edit mode with a macro, but I don't know how to change status or how to write a comment with a macro, any ideas?
Here is my code:
Sub TT()
Dim ie(40) As Object, obj As Object
Dim cislo As String
For i = 0 To 40
If Cells(i + 2, 1).Value = "" Then
Exit Sub
End If
Set ie(i) = CreateObject("Internetexplorer.Application")
ie(i).Visible = True
ie(i).Navigate "http://adress of sharepoint list .com"
Do While ie(i).Busy
Loop
Next i
End Sub
These tutorials should give you what you need to know...excellent and well done, they show you how to do it via Listobjects and via SQL
https://www.youtube.com/watch?v=nM-gq3N6f2E
There is a series of 13 videos.
I am working on a userform trying to loop through the controls in a multipage.
The user form has 2 Multipages (MultiPage1 and MultiPage2).
Multipage2 is contained within the Multipage1.
When only MultiPage1 exists I could ran the following code:
For Each pPage In frmValidationTest.MultiPage1.Pages
But after creating this nested system, and I trying to run it again, displays the following error:
"Type Mismatch" (in the For Each pPage line)
The variable pPages is declared as follows:
Dim pPage as Page
I've ran Debug.Print Mode to check misspelling issues but everything is OK ("frmValidationTest.MultiPage1.Pages.Name" does actually print out an output)
When I take a look at the pPages, it declares that the variable is Nothing.
I just realized that when declaring the variable, I have 2 classes with the same name "Page".
Not sure what's going on, is that normal? I don't think I should have 2 different classes for the same superclass. (-F2- Ref Lib only shows 1).
After closing, restarting, etc. The issue still there.
Hopefully is just a minor thing!
Many thanks in advance.
There is a Page class in both the Excel and MSForms libraries. So you will be better off using the library names in your declarations. For example, if your form looks like this:
Then this code should work:
Option Explicit
Private Sub CommandButton1_Click()
' declare variables using specific libraries
Dim mpgItem1 As MSForms.MultiPage
Dim mpgItem2 As MSForms.MultiPage
Dim pagItem1 As MSForms.Page
Dim pagItem2 As MSForms.Page
' other variables
Dim ctlItem As Control
Dim intCounter1 As Integer
Dim intCounter2 As Integer
Dim intPageCount1 As Integer
Dim intPageCount2 As Integer
Set mpgItem1 = UserForm1.MultiPage1
' get page count of first multi page
intPageCount1 = mpgItem1.Pages.Count
' not using for..each loop ...
For intCounter1 = 0 To intPageCount1 - 1
Set pagItem1 = mpgItem1.Pages(intCounter1)
MsgBox pagItem1.Name
For Each ctlItem In pagItem1.Controls
' looking for nested multi page
If TypeName(ctlItem) = "MultiPage" Then
' same code as for first multipage
Set mpgItem2 = ctlItem
intPageCount2 = mpgItem2.Pages.Count
For intCounter2 = 0 To intPageCount2 - 1
Set pagItem2 = mpgItem2.Pages(intCounter2)
MsgBox pagItem2.Name
Next intCounter2
End If
Next ctlItem
Next intCounter1
End Sub
I'm analyzing survey responses and just want to recode them from the assigned numerical value back to their original meanings using a command button (is this even the most efficient format?). I'd like to escape the tedium of lots of clicking and "Find/Replace". Here's a sample of what I'm working with:
Sub Button1_Click()
Dim response As Integer, result As String
response = ActiveSheet.Range("A3:A58").Value
If response = 1 Then result = "Individual Public School"
...
If response = 8 Then result = "Museum (or other science-rich institution)"
ActiveSheet.Range("B3:B58").Value = result
End Sub
Excel is stopping me at the third line, prompting me with a debug option. Where am I going wrong? Is there a more elegant solution for this?
I'm on a Mac computer, and I'm using Microsoft Office 2010 version, if this helps at all.
Any and all tips are welcome! Thanks.
You need something like:
Sub Button1_Click()
For Each r In Range("A3:A58")
If r.Value = 1 Then r.Offset(0, 1) = "Individual Public School"
'...
If r.Value = 8 Then r.Offset(0, 1) = "Museum (or other science-rich institution)"
Next r
End Sub