MAX Number VBA

I have a lot of blocks With these names: block-1 block-2 Block-5 Block-11 Block-34... etc...

I want to get the numbers from the block name (1,2,5,11,35...) and determinate the maximum number + 1

Can somebody help me?

Presuming that the blocks are already stored in an array and the index start always from the 7th character (length no matter):

Blockslist = Array("Block-1", "Block-7", "Block-35", "Block-2", "Block-11")

The code below will solve your issue:

Dim BlockItem As Integer
Dim LastIndex As String: Dim CurrentIndex As String

LastIndex = Mid(Blockslist(0), 7)                'retain first index as reference
For BlockItem = 1 To UBound(Blockslist)
   CurrentIndex = Mid(Blockslist(BlockItem), 7)
   If CInt(CurrentIndex) > CInt(LastIndex) Then   'compare with current item's index
       LastIndex = CurrentIndex                   'and retain it if bigger
   End If
Next BlockItem
LastIndex = LastIndex + 1                          'increase maximum index 

Regards,

Thx, it was very helpful...

And how to add the block names to the array?

The function above will allow you to sort all blocks defined in current drawing based on a name pattern:

Public Function SelectBlocksByPattern(ByVal NamePattern As String)
   Dim theBlock As Variant: Dim BlocksList As Variant
   Dim BlockName As String

   BlocksList = Array()
   For Each theBlock In ThisDrawing.Blocks                       'parse blocks database
       BlockName = theBlock.Name                                 'retain block's name

       If Left(BlockName, Len(NamePattern)) = NamePattern Then   'compare with argument pattern
           ReDim BlocksList(UBound(BlocksList) + 1)              'and retain it it match
           BlocksList(UBound(BlocksList)) = BlockName
       End If
   Next theBlock

   SelectBlocksByPattern = BlocksList                            'return found blocks list

End Function

Use it like:

BlocksList = SelectBlocksByPattern("Block-")

Regards,

I have little problem, the code works fine when only one block is in the drawing file (Block-1), when there is more than one (Block-1, Block-2,...) then I have a "run time error" message.

Public Sub Lindex()
Dim BlockItem As Integer
Dim LastIndex As String: Dim CurrentIndex As String

BlocksList = SelectBlocksByPattern("Block-")

LastIndex = Mid(BlocksList(0), 7)                'retain first index as reference
For BlockItem = 1 To UBound(BlocksList)
   CurrentIndex = Mid(BlocksList(BlockItem), 7)
   If CInt(CurrentIndex) > CInt(LastIndex) Then   'compare with current item's index
       LastIndex = CurrentIndex                   'and retain it if bigger
   End If
Next BlockItem
LastIndex = LastIndex + 1                          'increase maximum index
MsgBox LastIndex
End Sub

Public Function SelectBlocksByPattern(ByVal NamePattern As String)
   Dim theBlock As Variant: Dim BlocksList As Variant
   Dim BlockName As String

   BlocksList = Array()
   For Each theBlock In ThisDrawing.Blocks                       'parse blocks database
       BlockName = theBlock.Name                                 'retain block's name

       If Left(BlockName, Len(NamePattern)) = NamePattern Then   'compare with argument pattern
           ReDim BlocksList(UBound(BlocksList) + 1)              'and retain it it match
           BlocksList(UBound(BlocksList)) = BlockName
       End If
   Next theBlock

   SelectBlocksByPattern = BlocksList                            'return found blocks list

End Function

Try this modified code – missed the magic word "Preserve"…

Have also added a protection for the case when there are no block definitions in current drawing.

Public Sub Lindex()
   Dim BlockItem As Integer
   Dim LastIndex As String: Dim CurrentIndex As String
   [color=red]Dim BlocksList As Variant[/color]

   [color=black]BlocksList = SelectBlocksByPattern("Block-")[/color]

[color=red]    If UBound(BlocksList) = -1 Then Exit Sub           'exit if no block available[/color]

   LastIndex = CInt(Mid(BlocksList(0), 7))            'retain first index as reference
   For BlockItem = 1 To UBound(BlocksList)
       CurrentIndex = Mid(BlocksList(BlockItem), 7)
       If CInt(CurrentIndex) > LastIndex Then         'compare with current item's index
           LastIndex = CurrentIndex                   'and retain it if bigger
       End If
   Next BlockItem
   LastIndex = LastIndex + 1                          'increase maximum index

MsgBox LastIndex
End Sub

Public Function SelectBlocksByPattern(ByVal NamePattern As String)
   Dim theBlock As Variant: Dim BlocksList As Variant
   Dim BlockName As String

   BlocksList = Array()
   For Each theBlock In ThisDrawing.Blocks                       'parse blocks database
       BlockName = theBlock.Name                                 'retain block's name

       If Left(BlockName, Len(NamePattern)) = NamePattern Then   'compare with argument pattern
           ReDim [color=red]Preserve[/color] BlocksList(UBound(BlocksList) + 1)     'and retain it it match
           BlocksList(UBound(BlocksList)) = BlockName

       End If
   Next theBlock

   SelectBlocksByPattern = BlocksList                            'return found blocks list

End Function

Regards,

Thx, Very much...

You're welcome!