I have an issue. I'm working on VBA macros in MS Project 2013, that can automatically fill and change lookup table, which linked with local custom field in project professional. I have these code sections on VBA for:
-adding entries
Set objStateEntry = objOutlineCode.LookupTable.AddChild(entryName)
-changing descrption of entries
objStateEntry.Description = "some description"
-changing level of entires
objStateEntry.level = entryLevel
But I can't find how to programmatically move entries up/down in lookup table. In other words I need to use marked in the screenshot buttons programmatically. Please help me. Thank you!
Try something like this:
Private Sub SpinButton1_SpinDown()
On Error Resume Next
If ListBox1.ListIndex = ListBox1.ListCount - 1 Then Exit Sub
With Me.ListBox1
.ListIndex = .ListIndex + 1
End With
End Sub
Private Sub SpinButton1_SpinUp()
On Error Resume Next
If ListBox1.ListIndex = 0 Then Exit Sub
With Me.ListBox1
.ListIndex = .ListIndex - 1
End With
End Sub
goodluck
I tried recording a macro while using the spin button you highlighted, but this indicates that VBA can't control the spin button...
So it seems the only way to change the index of a lookup table entry by VBA is to first delete the entry then add it back, for example moving entry at index=4 up to index=2 (after saving the name and description of entry index=4):
Dim lteName As String
Dim lteDesc As String
lteName = Application.CustomFieldValueListGetItem(pjCustomResourceOutlineCode2, pjValueListValue, 4)
lteDesc = Application.CustomFieldValueListGetItem(pjCustomResourceOutlineCode2, pjValueListDescription, 4)
Application.CustomFieldValueListDelete FieldID:=pjCustomResourceOutlineCode2, Index:=4
Application.CustomFieldValueListAdd FieldID:=pjCustomResourceOutlineCode2, Value:=lteName, Description:=lteDesc, Index:=2
Two caveats:
1: It appears you can't do the above in the same macro that you are adding the lookup table entries. It only works in another macro run after adding the entries.
2: At least in my version of MS Project, the index number is flaky (it should be consecutive but sometimes index numbers repeat or there are gaps but then it corrects itself!), no doubt due to deleting and adding entries like I am suggesting. The code won't work if the index numbers that VBA is looking for don't match what is displayed in the lookuptable window. Oh dear... wish MSProject was perfect!
Noted same behaviour on another SO thread here.
Related
I have an Excel file that takes data from outside and writes it in a ListObject.
As adding rows one by one through ListRows.Add is very slow, I add the right number of empty rows to the sheet and resize the ListObject.
This works really well in Excel 2010.
With Excel 2007, it works but when the user closes the workbook or Excel, it freezes and Windows displays its crash window (asking if you want to close, restart or debug the application).
This is really annoying and doesn't look very good :).
Any idea of what I could do to prevent that?
Maybe you have a better idea to quicky ladd thousands of rows in a ListObject?
Moreover randomly (I reopen the file change nothing and execute the macro), Resize fails with an error message and Excel crashes if I stop the execution.
Here is the function that adds the empty rows, if I follow it step by step it all the ranges are correct and it does what I need.
I'm pretty sure this is this function that causes the problem as it disappears when I comment the call to that function.
Sub AddRowsToListObject(sheetName As String, myTable As ListObject, addRows As Long)
Dim i As Long
If addRows > 0 Then
Sheets(sheetName).Activate
'Add empty rows at the end
i = myTable.DataBodyRange.row + myTable.ListRows.Count
Sheets(sheetName).Range(Cells(i, 1), Cells(i + addRows - 2, 1)).EntireRow.Insert shift:=xlDown
'Offset -1 as you need to include the headers again
myTable.Resize myTable.DataBodyRange.Offset(-1, 0).Resize(myTable.ListRows.Count + addRows, myTable.ListColumns.Count)
End If
End Sub
Unfortunately I don't have Excel 2007 and cannot replicate the error described in the question. However and assuming that:
The code is not trying to add rows beyond the capacity of Excel 2007
The error is caused by the method used to add new lines to the existing ListObject
And since you are asking for an alternative method to add thousands of rows to an existing ListObject
Try the code below
Sub ListObjects_AddRows(myTable As ListObject, addRows As Long)
If addRows > 0 Then
With myTable.DataBodyRange
.Offset(.Rows.Count, 0).Resize(addRows, 1).EntireRow.Insert
With .Offset(.Rows.Count, 0).Resize(addRows, 1)
.Value = "X"
.ClearContents
End With: End With: End If
End Sub
add Application.ScreenUpdating = False right after the start of the sub
add Application.ScreenUpdating = True right before the end
If you are doing 1000s then you definitely don't need the screen refreshing each time a new line gets drawn. Change that and it will only redraw it once it is finished.
After a lot of painful testing, it looks like the problem is not in this method but in the deleting of the rows just before that :
Sub ResetListObject(myTable As ListObject)
myTable.DataBodyRange.ClearContents
If myTable.DataBodyRange.Rows.Count > 1 Then
myTable.DataBodyRange.Offset(1, 0).Resize(myTable.DataBodyRange.Rows.Count - 1, myTable.DataBodyRange.Columns.Count).EntireRow.Delete shift:=xlUp
End If
End Sub
Excel 2010 requires you to always keep 1 row when you empty the ListObject.
But Excel 2007 requires 2 rows !!
I don't know why and I can't find any information on that.
I changed my script to delete all rows except 2 and changed the function in the OP to manage that fact.
VBA Newbie here.
I have searched high and low for this answer, and even come across other questions very similar to mine, but cannot get an answer. So I am hoping that this is my lucky day.
I have a Userform in excel that has Four combo boxes. Each combo box has a drop down with several choices. In two of these boxes, there are many business names and a lot of these names are similar. I was wanting to have the feature where are the data was being typed into the box, it would begin to narrow the options. EXAMPLE: if I type "heating and air" it begins to only show items in the list that include that word or phrase.
Is this a properties change in the box, or a code written, or something else?
Please help- I am stumped and no one seems to have the answer.
Very grateful-
Excel Newbie
Yes this is very possible. All you have to do is create a sub that populates that combo box, set it up so that when adding it checks the value of the box for example if it was the basic typing example. basic format. This assumes the possible values are stored in an array. This would add any item that has the string entered in it. (in any position)
For I = 0 to Number of Values
If instr(Value(I), ComboBox.Text) > 0 then
add item
endif
next
I played around a bit and came up with something to get you started. This basically functions as an "auto search". It is not autocomplete because it will search entire terms, not just terms which begin with whatever you've typed in. Basically I assume you have a range of cells (in this example cells A2:A121) that have the date for your drop down in it.
Setup
Add a new generic module (I named mine GlobalVars and add the following code:
Option Explicit
Public IgnoreChange As Boolean
Public RangeOfData As Variant
The Code
Open the code to your UserForm.
Add the following code:
Private Sub UserForm_Initialize()
RangeOfData = Application.WorksheetFunction.Transpose(Sheet1.Range("A2:A121").Value)
IgnoreChange = False
End Sub
Be sure to update A2:A121 and Sheet1 (I am using code name, but Worksheets("Sheet1") would work just as well) to point to the data which contains your combobox choices.
Now, the meat of the job is handled in the Combobox_Change event
Private Sub ComboBox1_Change()
If Me.ComboBox1.Text = vbNullString Then
Me.ComboBox1.Clear
SendKeys ("{Enter}")
End If
If Me.ComboBox1.TextLength > 2 Then
Dim i As Long, j As Long
If IgnoreChange = False Then
Me.ComboBox1.Clear
SendKeys ("{Enter}")
DoEvents 'Bug with NumLock
For i = LBound(RangeOfData) To UBound(RangeOfData)
If UCase(RangeOfData(i)) Like "*" & UCase(Me.ComboBox1.Text) & "*" Then
Me.ComboBox1.AddItem RangeOfData(i)
End If
Next i
Me.ComboBox1.DropDown
End If
End If
IgnoreChange = False
End Sub
Be sure to change ComboBox1 to the name of your combobox control.
Basically, what this does is it handles user input when it reaches two characters or longer. The code will search through your input data range and then return results that match the string as the user is entering it. The results is like a suggestions box.
I should note that with this method, the combobox is NOT pre-populated with data, so users must begin typing something into the combobox.
Additionally, I added the following code to handle the backspace key:
Private Sub ComboBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
If KeyCode = 8 Then
IgnoreChange = True
End If
End Sub
Again be sure to change ComboBox1 as appropriate.
For my example, I loaded all 120 crayola crayon colors into a spreadsheet (that is what is in Sheet1 from A2:A121).
Here is example output for when I start typing, first I input blu:
As you can see I am getting all values that contain blu, including those that don't start with blu such as Cadet Blue or Midnight blue.
As another example, I will search for flower
So as you can see, instead of being a combobox with 120 static options, it is updated based on what the user types and tied to a list of values in your cells.
I did notice that SendKeys sometimes toggled my NumLock, this is a known issue. The point of that line is to collapse the drop down after the user deletes all of the text or continues texting so as to "refresh" the auto-generated list.
I want a module in my workbook to write about a thousand combinations of the below
Sub trade0001open()
Sheets("TRADEDIARY").Range("AO2").Value = 1
Sheets("TRADEDIARY").Range("AD3").Value = _
Sheets("TRADEDIARY").Range("AJ2").Value
Sheets("TRADEDIARY").Range("AD4").Value = _
Sheets("Sheet8").Range("HA1").Value + 1
Sheets("TRADEDIARY").Range("AO3").Value = 0
End Sub
Sub trade0001close()
Application.ScreenUpdating = False
Sheets("TRADEDIARY").Range("AI3").Value = Sheets("TRADEDIARY").Range("AI3").Value + 1
Sheets("TRADEDIARY").Range("AO3").Value = 1
Application.Wait (Now + 0.000001)
Sheets("TRADEDIARY").Range("AO3").Value = 0
Sheets("TRADEDIARY").Range("AO2").Value = 0
Sheets("TRADEDIARY").Range("AI2").Value = Sheets("TRADEDIARY").Range("AI2").Value + 1
Application.ScreenUpdating = True
End Sub
Changing changing the cell references by a cumulator of four rows down each time. So every AO2 would become AO6 in the next every AD3 becomes AD7. Everything apart from HA1 would change so that includes AO2,AD3,AJ2,AD4,AO3 for the first sub and then that includes AI3, AO3, AO2, AI2 for the second sub.
So since my code above contains the two subs I'd like copied a thousand times - each copy will add 4 rows to each cel reference in each sub.
I am quite new to vba so I guess I am after a similar autofill function like in excel except for my code to do this quickly instead of typing thousands of times unless of course I guess somebody could suggest how to do this differently. hint hint. bare in mind I obviously want all the values pasted without a clipboard so that when those values from where they are copied change, the destination doesn't change. Which is what my above code achieves.
Then I'd like to asign each individual sub within each of the two separately to a developer button control in the spread sheet ( again asigned to change four rows down each time)
#matteo to clarify ''well I envisioned the only way was to have 1000 trade0001open() and 1000 trade001close() possibly defined as trade0001open() , trade0002open() etc ditto close etc etc in order to right click for each one on a vba developer for control button alligned to each cell AK4 for open button and AM4 for close button so AK8 and AM8 etc etc which is long winded again and Im refraining from assuming a developer button could be alligned to each of those cells frm within vba and assigned to each of the sub at the moment. I guess one workaround might be to configure the j somehow into the sub name .''
matteo's reply: ''What you ask is complex to answer here, i will give you a tip to get started: use always the same macro but intercept the reference of the cell from which the call starts in order to add dinamically the 4 rows as I showed you above. You don't need 2000 macros, only 2 that are readapting themselves depending on the caller parent''
me : ''so I guess this is more complicated than it seems if I could somehow make form button's alligned to cells to reference the j value within the 2 macros without need for making thousands of sub macros. As far as I know form buttons in excel can only reference sub functions without reference and not UDFs or anything else or even cell references although I probably am wrong about this. ''
a form button to call the sub based on a cell's reference that is what I need right?
http://www.mrexcel.com/forum/excel-questions/843078-loop-visual-basic-applications-sub-call-form-button-each-nth-row-based-cell-value-row-reference.html#post4105072
I don't know for the life of me where to begin Trying to call a Sub with a String - VBA
You just need to make every string dinamically redefined and loop 1000 times the same macro. This is an example to get started:
For j = 1 To 1000 '<-- do this 1000 times
'...
Sheets("TRADEDIARY").Range("AO" & 2 + (j-1)*4).Value = 1 '<-- if j=1 then row = 2, if j=2 then row = 2+4 = 6 etc.
'...
Next j
I have a form with listbox which dynamically provides a list of the worksheets in the current workbook (code below). I wish to take the selected Sheet and refer to it in a formula later in the process. From hours of playing around I cannot seem to accomplish this. I believe I read somewhere that you cannot take the string back to the sub and use it to refer to to an object. So I thought maybe I can create two listboxes
for sheet name
for sheet index
that I could pass the index number to and maybe use that in my formula to lookup items from the correct sheet.
For the life of my I cannot seem to find a way to connect the two since the items will always be changing; the code will be ran on multiple workbooks by multiple operators so the layout will most likely change between users. I can easily add the second list box with index #'s but I have a block on how to associate the name which will have meaning to the user and the index which I can pass back to the sub. I realize the "On click" procedure for the list box to associate the two but with the dynamic nature of the fields I cannot come up with the logic to put that into code.
For N = 1 To ActiveWorkbook.Sheets.Count
With ListBox1
.AddItem ActiveWorkbook.Sheets(N).Name
End With
Next N
Try this out.
Declare a public variable above the code for the UserForm, making it available throughout your workbook from any module or code.
Public listChoice As String
Using your code to get the sheet names for the ListBox rowsource.
Private Sub UserForm_Activate()
For n = 1 To ActiveWorkbook.Sheets.count
With ListBox1
.AddItem ActiveWorkbook.Sheets(n).name
End With
Next n
End Sub
Including an update event for the ListBox
Private Sub ListBox1_AfterUpdate()
listChoice = ListBox1.Text
End Sub
I included a test just to demonstrate that the result is still retained. You don't need this, it demonstrates the results on the screenshot.
Private Sub cmdTestChoice_Click()
MsgBox ("The choice made on the ListBox was: " & listChoice)
End Sub
edit: To access that sheet later, you can call it using something like this:
Some examples of different ways to access a cell, using .Range, or .Cells, with numbers or letters.
Using lRow & lCol as Long to set row and column numbers.
Sheets(listChoice).Cells(lRow, lCol).Value = TextBox1.Value 'Set cell on sheet from TextBox
TextBox2.Value = Sheets(listChoice).Range("A2").Value 'Set TextBox From Cell on Sheet
'Set a cell on another sheet using the selected sheet as a source.
Sheets("AnotherSheet").Cells(lRow, "D") = Sheets(listChoice).Range("D2")
I am working in MS Word 2013 and attempting to programatically delete rows in a table when Checkbox1 through CheckboxN is unchecked through use of a command button. The following abbreviated code works once (and can delete one or more rows) but breaks when run a second since the code still makes references to checkboxes that have been deleted. I have tried basic error handling but have been unsuccessful. Can anyone provide assistance so the code can be run multiple times and delete subsequent rows/checkboxes? If this is not the right forum to post this request, please let me know. Thank you!
Sub CommandButton1_Click()
If CheckBox1.Value = False Then
Selection.GoTo What:=wdGoToBookmark, Name:="Row6"
Selection.Rows.Delete
End If
If CheckBoxN.Value = False Then
Selection.GoTo What:=wdGoToBookmark, Name:="Row6"
Selection.Rows.Delete
End If
End sub
So, I'd probably take a different approach here. Rather than relying on named checkboxes, cycle backwards through all relevant checkboxes and determine the row to delete. I'm assuming that the checkboxes are in a cell within the row to be deleted. It's important to go backwards because, as you've noted, you'll be removing items as you go.
Sub checkChecks()
Dim objTable As Table
Dim objCC As ContentControl
Dim i As Long
Set objTable = ActiveDocument.Tables(1)
For i = objTable.Range.ContentControls.Count To 1 Step -1
Set objCC = objTable.Range.ContentControls(i)
If objCC.Type = wdContentControlCheckBox Then
If objCC.Checked = False Then objCC.Range.Rows(1).Delete
End If
Next i
End Sub
Obviously this only works if you can isolate the table in question, but that shouldn't be too hard.