Display the text before the 6th instance of a period in a string (MS Project or VBA)

[sahderach]

Hello!

I'm trying to figure out a macro that can display the text before the 6th instance of a period in a string.

=TEXTBEFORE(".",6) works perfectly in Excel but I need this to work in MS Project and I don't know of a formula that will do this using MS Project's list of commands.

If this is possible using MS Project's limited functions, that would be ideal but I think a macro would be easier.

I'm not very strong in VBA so any help would be greatly appreciated, thanks!

Original	TEXTBEFORE 6th "."
1.2.3.4.5.6.7.8	1.2.3.4.5.6
1.2.3n.4.5.5.6.7	1.2.3n.4.5.5
1n.2n.3n.4n.5.6.7.8	1n.2n.3n.4n.5.6
1.2.3.3n.5.9n.10.8n.9n.10n	1.2.3.3n.5.9n

 

[Micron]

This should work in either Access or Excel vba - if it's in a standard module. I've no experience with Project vba so you'd have to try.

Function GetToDotSix(strIn As String) As String
Dim i As Integer, n As Integer
'call as someThing = GetToDotSix("1.2.3.3n.5.9n.10.8n.9n.10n")

For i = 1 To Len(strIn)
  If Mid(strIn, i, 1) = "." Then n = n + 1
     If n = 6 Then
       MsgBox Left(strIn, i - 1)
       Exit Function
   End If
Next

End Function

Instead of hard coding string, perhaps you would reference the cell object from Project.
EDIT - You'd have to do something other than a msgbox of course. That code doesn't worry about less than 6 dots or if there is no value.

 

[sahderach]

This should work in either Access or Excel vba - if it's in a standard module. I've no experience with Project vba so you'd have to try.

Function GetToDotSix(strIn As String) As String
Dim i As Integer, n As Integer
'call as someThing = GetToDotSix("1.2.3.3n.5.9n.10.8n.9n.10n")

For i = 1 To Len(strIn)
  If Mid(strIn, i, 1) = "." Then n = n + 1
     If n = 6 Then
       MsgBox Left(strIn, i - 1)
       Exit Function
   End If
Next

End Function

Instead of hard coding string, perhaps you would reference the cell object from Project.

Thank you so much! I believe this is a good starting point for some experimentation on my part because yes, Project VBA is a bit different than Excel, so I'll have to modify it somehow to run in Project. Thanks again, I know it's a pain when given little to work with but I appreciate your time!

 

[Micron]

Slight mod; will handle cases where input has less than six .
It already would handle if input was an empty string - I just overlooked that. Please do post your code when you figure it out. I'd like to learn how you did it.

Function GetToDotSix(strIn As String) As String
Dim i As Integer, n As Integer
'call as GetToDotSix("1.2.3.3n.5.9n.10.8n.9n.10n")

For i = 1 To Len(strIn)
    If Mid(strIn, i, 1) = "." Then n = n + 1
    If n = 6 Then
       MsgBox Left(strIn, i - 1)
       GetToDotSix = Left(strIn, i - 1)
       Exit For
    End If
Next

If n > 0 And n < 6 Then MsgBox "Not enough dot characters to process"

End Function

EDIT - I've bookmarked Access portion of Office object model. Here's the Project section in case you can use it.

Project object model

Office VBA reference topic

learn.microsoft.com

 

[sahderach]

Slight mod; will handle cases where input has less than six .
It already would handle if input was an empty string - I just overlooked that. Please do post your code when you figure it out. I'd like to learn how you did it.

Function GetToDotSix(strIn As String) As String
Dim i As Integer, n As Integer
'call as GetToDotSix("1.2.3.3n.5.9n.10.8n.9n.10n")

For i = 1 To Len(strIn)
    If Mid(strIn, i, 1) = "." Then n = n + 1
    If n = 6 Then
       MsgBox Left(strIn, i - 1)
       GetToDotSix = Left(strIn, i - 1)
       Exit For
    End If
Next

If n > 0 And n < 6 Then MsgBox "Not enough dot characters to process"

End Function

EDIT - I've bookmarked Access portion of Office object model. Here's the Project section in case you can use it.

Project object model

Office VBA reference topic

learn.microsoft.com

I got it to work on only the first row using this modified version of your code (MS Project does not seem to be able to use UDFs)

I'm obviously messing up the For loop. Any ideas on how to fix it?

Thanks!

Sub GetToDotSix()

Dim i As Integer, n As Integer

Dim tsk As Task

Dim taskList As Tasks


Set taskList = ActiveProject.Tasks

For Each tsk In ActiveProject.Tasks

If Not tsk Is Nothing Then

For i = 1 To Len(tsk.Text1)

If Mid(tsk.Text1, i, 1) = "." Then n = n + 1

If n = 6 Then

tsk.Text2 = Left(tsk.Text1, i - 1)

Exit For

End If

Next

If n > 0 And n < 6 Then MsgBox "Not enough dot characters to process"

End If

Next

End Sub

Result:

https://imgur.com/a/PAKKlra

Result:

https://imgur.com/a/PAKKlra

Result:

https://imgur.com/a/PAKKlra

 

[Micron]

All 3 images look the same to me? Looks like you pasted that code from something that injects line wraps. Between that and the lack of indentation I don't even want to read it (it's just too hard). Attempting to fix that:

Sub GetToDotSix()
Dim i As Integer, n As Integer
Dim tsk As Task
Dim taskList As Tasks

Set taskList = ActiveProject.Tasks
For Each tsk In ActiveProject.Tasks
   If Not tsk Is Nothing Then
      For i = 1 To Len(tsk.Text1)
         If Mid(tsk.Text1, i, 1) = "." Then n = n + 1
         If n = 6 Then
            tsk.Text2 = Left(tsk.Text1, i - 1)
            Exit For
         End If
      Next
      If n > 0 And n < 6 Then MsgBox "Not enough dot characters to process"
   End If
Next

End Sub

I can't imagine that udf's cannot be used in project vba but can't test that. Perhaps your udf does not have the required scope.
Suggest you step thru the code (F8) and watch your variables and such. You don't SET your tsk variable to anything, so I imagine that's a problem, assuming it is an object. After that, report back and if you discovered no issues I'll see if I can see a problem with the loop.
Also, at the end it's advisable to set object variables to Nothing - at least in other Office vba code.
Have to wonder why the test for Is Nothing? Can you have a task as a member of a collection of Tasks and loop thru and find that one is 'nothing'?

 

[sahderach]

Sorry about the formatting!

The code below fixed my problem.

I really appreciate your help and effort in this!

Sub Sixth_dot() 
Dim t As Task 
Dim T1_String() As String 
Dim t2_string As String 

For Each t In ActiveProject.Tasks    
          T1_String() = Split(t.Text1, ".")    
          If UBound(T1_String) < 5 Then        
               t.Text2 = "Not enough dot characters to process"    
          Else        
               For i = LBound(T1_String) To 5            
                    If i = 0 Then                
                              t.Text2 = T1_String(I)            
                    Else                
                              t.Text2 = t.Text2 & "." & T1_String(I)            
                    End If        
               Next I    
          End If 
Next t
 
End Sub

 

[Micron]

I gather that you were able to get code from somewhere else, which looks interesting because I considered an array but didn't know how I could use it with Project. I take it that you are in fact able to use udf's in Project. Thanks for posting a solution. You might as well mark your post as the solution.

 

[sahderach]

I gather that you were able to get code from somewhere else, which looks interesting because I considered an array but didn't know how I could use it with Project. I take it that you are in fact able to use udf's in Project. Thanks for posting a solution. You might as well mark your post as the solution.

Yes, the code was from another source. Again, really appreciate your time and effort!

 

[Micron]

You're welcome! Good luck with your Project project!