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
Related
Excel now has the possibility to store personal filtering views to help collaboration in simultaniously used documents.
I could only find Microsoft documentation for an add-in, but the function is available in my Excel version of MS Excel for Microsoft 365 MSO (16.0.13127.20266) 32bit.
https://learn.microsoft.com/en-us/javascript/api/excel/excel.namedsheetview?view=excel-js-preview
I am trying to store the currently applied NamedSheetView name property (for later restoring option) but
this code fails:
Dim sh1 As Worksheet
Dim xViewName As String
Set sh1 = ThisWorkbook.Sheets(Sheet6.Name)
xViewName = sh1.NamedSheetView.Name
However this code works (with previously created "Test" view):
sh1.NamedSheetViews.GetItem("Test").Activate
If this NamedSheetViews is a collection, I should be able to get the item property, but these codes also fail:
strName = sh1.NamedSheetViews.GetItem(1).Name
strName = sh1.NamedSheetViews.Item(1).Name
Anyone has ever succeeded in getting the current NamedSheetView of a Worksheet?
Here is how I probe unknown Object properties:
I start with a reference to the Object. If I don't know what the Object is I use TypeName() to return it's class name (data type). I then declare a variable of that data type. Wash, rinse and repeat as I drill down the structure. Once the variable is declared, selecting the variable and pressing F1 with open the Microsoft Help document for that data type.
Module Code
Sub WhatIsThat()
Const TestName As String = "TestName"
Dim View As NamedSheetViewCollection
Set View = Sheet6.NamedSheetViews
On Error Resume Next
View.GetItem(TestName).Delete
On Error GoTo 0
View.Add TestName
Dim SheetView As NamedSheetView
Dim n As Long
For n = 0 To View.Count - 1
Debug.Print View.GetItemAt(n).Name
Set SheetView = View.GetItemAt(n)
Debug.Print SheetView.Name
Next
Stop
End Sub
Immediate Window Tests
?TypeName(Sheet6.NamedSheetViews)
?View.GetItemAt(0).Name
?TypeName( View.GetItemAt(0))
SOLUTION:
(Thanks for the great help from TinMan)
Dim SheetView As NamedSheetView
Dim sh1 As Worksheet
Dim ActiveSheetView as string
Set sh1 = ThisWorkbook.Sheets(Sheet6.Name)
Set SheetView = sh1.NamedSheetViews.GetActive
ActiveSheetView = SheetView.Name
Application:
sh1.NamedSheetViews.GetItem(ActiveSheetView).Activate
I keep having an issue with some code in VBA Excel was looking for some help!
I am trying to sort through a list of names with corresponding phone numbers, checking for multiple names under the same phone number. Then post those names to a separate sheet.
So far my code is:
Sub main()
Dim cName As New Collection
For Each celli In Columns(3).Cells
Sheets(2).Activate
On Error GoTo raa
If Not celli.Value = Empty Then
cName.Add Item:=celli.Row, Key:="" & celli.Value
End If
Next celli
On Error Resume Next
raa:
Sheets(3).Activate
Range("a1").Offset(celli.Row - 1, 0).Value = Range("a1").Offset(cName(celli.Value) - 1, 0).Value
Resume Next
End Sub
When I try to run the code it crashes Excel, and does not give any error codes.
Some things I've tried to fix the issue:
Shorted List of Items
Converted phone numbers to string using cstr()
Adjusted Range and offsets
I'm pretty new to all this, I only managed to get this far on the code with help from other posts on this site. Not sure where to go with this since it just crashes and gives me no error to look into. Any ideas are appreciated Thank you!
Updated:
Option Explicit
Dim output As Worksheet
Dim data As Worksheet
Dim hold As Object
Dim celli
Dim nextRow
Sub main()
Set output = Worksheets("phoneFlags")
Set data = Worksheets("filteredData")
Set hold = CreateObject("Scripting.Dictionary")
For Each celli In data.Columns(3).Cells
On Error GoTo raa
If Not IsEmpty(celli.Value) Then
hold.Add Item:=celli.Row, Key:="" & celli.Value
End If
Next celli
On Error Resume Next
raa:
nextRow = output.Range("A" & Rows.Count).End(xlUp).Row + 1
output.Range("A" & nextRow).Value = data.Range("A1").Offset(hold(celli.Value) - 1, 0).Value
'data.Range("B1").Offset(celli.Row - 1, 0).Value = Range("B1").Offset(hold
Resume Next
End Sub
Update2:
Used hold.Exists along with an ElseIf to remove the GoTo's. Also changed it to copy and paste the row to the next sheet.
Sub main()
Set output = Worksheets("phoneFlags")
Set data = Worksheets("filteredData")
Set hold = CreateObject("Scripting.Dictionary")
For Each celli In data.Columns(2).Cells
If Not hold.Exists(CStr(celli.Value)) Then
If Not IsEmpty(celli.Value) Then
hold.Add Item:=celli.Row, Key:="" & celli.Value
Else
End If
ElseIf hold.Exists(CStr(celli.Value)) Then
data.Rows(celli.Row).Copy (Sheets("phoneFlags").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0))
'output.Range("A" & nextRow).Value = data.Range("A1").Offset(hold(celli.Value) - 1, 0).Value
End If
Next celli
End Sub
When developing code, don't try (or be afraid of) errors as they are pointers to help fix the code or the logic. As such, don't use On Error unless it is absolutely indicated in the coding algorithm (*). using On Error when not necessary only hides errors, does not fix them and when coding it is always better to avoid the errors in the first place (good logic).
When adding to the Dictionary, first check to see if the item already exists. The Microsoft documentation notes that trying to add an element that already exists causes an error. An advantage that the Dictionary object has over an ordinary Collection object in VBA is the .exists(value) method, which returns a Boolean.
The short answer to your question, now that I have the context out of the way, is that you can first check (if Not hold.exists(CStr(celli.Value)) Then) and then add if it does not already exist.
(*) As a side note, I was solving an Excel macro issue yesterday which took me most of the day to nut out, but the raising of errors and the use of debugging code helped me make some stable code rather than some buggy but kind-of-working code (which is what I was fixing in the first place). However, the use of error handling can be a short cut in some instances such as:
Function RangeExists(WS as Worksheet, NamedRange as String) As Boolean
Dim tResult as Boolean
Dim tRange as Range
tResult = False ' The default for declaring a Boolean is False, but I like to be explicit
On Error Goto SetResult ' the use of error means not using a loop through all the named ranges in the WS and can be quicker.
Set tRange = WS.Range(NamedRange) ' will error out if the named range does not exist
tResult = True
On Error Goto 0 ' Always good to explicitly limit where error hiding occurs, but not necessary in this example
SetResult:
RangeExists = tResult
End Function
When I try to write something from the method given by EPPlus i.e. It comes up with two error messages
We have found a problem with some content
Excel completed file level validation and repair. some parts of this workbook may have been repaired or discarded.
Excel opens successfully but, with error messages and one more thing excel I'm writing is already written that means it is a template.
Dim consh As ExcelWorksheet
'Dim excelStream As New MemoryStream()
'excelStream.Write(excel, 0, excel.Length)
Dim exlpck As New ExcelPackage(excel)
If exlpck.Workbook.Worksheets(cellExcelTabName) Is Nothing Then
consh = exlpck.Workbook.Worksheets.Add(cellExcelTabName)
Else
consh = exlpck.Workbook.Worksheets(cellExcelTabName)
End If
Dim start = consh.Dimension.Start
Dim [end] = consh.Dimension.[End]
For row As Integer = 4 To [end].Row
' Row by row...
For col As Integer = 18 To 35
' ... Cell by cell...
' This got me the actual value I needed.
Dim cellValue As String = consh.Cells(row, col).Text
Dim cellAddress = consh.Cells(row, col).Address
Dim i = 0
For Each mText In textToFind
If cellValue.Contains(mText) Then
consh.Cells(cellAddress).Value = cellValue.Replace(mText, "")[enter image description here][1]
consh.Cells(cellAddress).Style.Fill.PatternType = ExcelFillStyle.Solid
consh.Cells(cellAddress).Style.Fill.BackgroundColor.SetColor(color(mText.Substring(1, 1) - 1))
i = i + 1
End If
Next
Next
Next
'Dim exlpck1 As New ExcelPackage(e)
exlpck.Save()
Dim s = New MemoryStream(exlpck.GetAsByteArray())
Return s
As stated here ("I get an error that Excel has found unreadable content ..."), the EPPlus Package does not validate formulas and number formats. You might want to check there for hints.
I found the fix for my code
exlpck.Save()
to be Replaced by
exlpck.SaveAs(ms)
And it worked :)
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.
Hi guys i am new here and i am new to vba.
i want to solve the following problem:
i have two different access tables. each of them contains data i want to compare first and then, if a certain constraint is true i want to import certain columns out of one of the two access db tables into an excel sheet.
what i already have: the connection to the databases, i can read the data and print them on the console via debug.print command.
i have really no idea how to write certain rows (those which conform to the constraint) to the excel sheet.
Code sample
'commandstring and data base variables stands here
'non database connection variables
Dim oldID, newID, oldBuildPlanned, newBuildPlanned As String
Dim createExcel, doesExcelExist As Boolean
Dim xl As Excel.Application
Dim wb As Excel.Workbook
Dim Wksht As Excel.Worksheet
Dim dataVar As String
Dim counter As Integer
counter = 0
createExcelSheet = False
doesSheetExist = False
'Debug.Print "TEST old database"
Do While Not objRs.EOF And Not objRs2.EOF
'Debug.Print vbTab & objRs(0) & " " & objRs(1)
'assigning database values to variables to make them comparable
oldID = objRs(counter)
newID = CStr(objRs2(counter))
oldBuildPlanned = objRs(counter + 1)
newBuildPlanned = objRs2(counter + 1)
If oldID = newID And oldBuildPlanned = newBuildPlanned Then
createExcel = True
If createExcelSheet = True And Not doesSheetExist = True Then
Set xl = New Excel.Application
Set wb = xl.Workbooks.Add
Set Wksht = ActiveWorkbook.Worksheets("Sheet1")
doesExcelExist = True
End If
Call writeReport(newID)
End If
objRs.MoveNext
objRs2.MoveNext
Loop
'tidy up stuff comes here
end of code
I am sorry if my code is not formatted as its usual, its my first post in this forum ^^
So the writeReport() should contain the code to write the data into the sheet. i planned to insert the id's of the matching database entries into the method as parameters and read these certain data out of the recordset. but i cannot convert recordset items to string, so the byRef parameter declaration causes a compile error "type mismatch". In addition i tried to export the table with DoCmd.TransferSpreadsheet, but this method exports the entire table into excel, it worked, but it is not what i am searching for.
i hope someone can help me with my little low level problem, if you need further information feel free to ask me. i am using ADO.
Thanks in advance
Welcome to the forum,
I think you might find these two websites helpful for what you are trying to do. The first one is a great tutorial on using Access and Excel together.
http://www.datawright.com.au/excel_resources/excel_access_and_ado.htm
http://www.w3schools.com/sql/default.asp
I am not sure how you are creating your recordset, by I would recommend using an SQL statement as your source. That way you only pull the data from Access that you need. If you have any more specific questions, please let me know.
Jason