Looking for criticism. 1

[ItIsHardToProgram]

Hey,

I have recently designed a macro in order to split a cell arithmetic into mutltiple cells. This is a quite simple concept, but I found the time it took to design this, what I would think, "simply" macro, was quite arsh, I put around 5 hours on this, and I realize that my lack of experience was probably the cause.

None the less, I am constantly trying to improve, so I will paste down the code. You will notice it gets "lazy" at some point. Yes I prety much got it to do the most time consuming, and figured I would do the rest manualy.

Please, feel free to help, I did not design the multiple char split, I burrowed it from open source documents and tweaked it so it would work with what I was trying to do. Oh and btw, it is the most ergonomic of the 2 functions D:

Now the followings don't behave badly, they currently work and take about 15 seconds. I am just looking to improve my way of thinking through programming, I think my worst enemy is the fact I constantly refuse to use arrays and cursors, it seems to be the fastest ><

Multiple char function

Function SplitMultiDelimsEX(Text As String, DelimStrings As String, _
    DelimStringsSep As String) As String()
'''''''''''''''''''''''''''''''''''
' SplitMultiDelimsEX
' This function is like VBA's Split function or the SplitMultiDelims
' function, also in this module. It accepts any number of multiple-
' character delimiter strings and splits Text into substrings based
' on the delimiter strings. It returns an unallocated array if Text
' is empty, a single-element array if DelimStrings is empty, or a
' 1 or greater element array if Text was successfully split into
' substrings based on the DelimStrings delimiters.
'''''''''''''''''''''''''''''''''''
Dim Pos1 As Long
Dim N As Long
Dim M As Long
Dim Arr() As String
Dim I As Long
Dim DelimWords() As String
Dim DelimNdx As Long
Dim DelimWord As String
Dim bnegative As Boolean

'''''''''''''''
' if Text is empty, get out
'''''''''''''''
If Len(Text) = 0 Then
    Exit Function
End If

''''''''''''''''''''''''''
' if there are no delimiters, return the whole text
''''''''''''''''''''''''''
If DelimStrings = vbNullString Then
    SplitMultiDelimsEX = Array(Text)
    Exit Function
End If

'''''''''''''''''''''
' if there is no delim separator, get out
'''''''''''''''''''''
If DelimStringsSep = vbNullString Then
    Exit Function
End If

DelimWords = Split(DelimStrings, DelimStringsSep)
'If IsArrayAllocated(DelimWords) = False Then
'    Exit Function
'End If

''''''''''''''''''''''''
' oversize the array, we'll shrink it later so
' we don't need to use Redim Preserve
''''''''''''''''''''''''
ReDim Arr(1 To Len(Text))

I = 0
N = 0
Pos1 = 1

For N = Pos1 To Len(Text)
    For DelimNdx = LBound(DelimWords) To UBound(DelimWords)
        DelimWord = DelimWords(DelimNdx)
            Select Case DelimWord
                Case "="
                    If StrComp(Mid(Text, N, Len(DelimWord)), DelimWord, vbBinaryCompare) = 0 Then
                        I = I + 1
                        If bnegative = True Then
                            Arr(I) = "-" + Mid(Text, Pos1, N - Pos1)
                            bnegative = False
                        Else
                            Arr(I) = Mid(Text, Pos1, N - Pos1)
                        End If
                        Pos1 = N + Len(DelimWord)
                        N = Pos1
                    End If
                Case "+"
                    If StrComp(Mid(Text, N, Len(DelimWord)), DelimWord, vbBinaryCompare) = 0 Then
                        I = I + 1
                        If bnegative = True Then
                            Arr(I) = "-" + Mid(Text, Pos1, N - Pos1)
                            bnegative = False
                        Else
                            Arr(I) = Mid(Text, Pos1, N - Pos1)
                        End If
                        Pos1 = N + Len(DelimWord)
                        N = Pos1
                    End If
                Case "-"
                    If StrComp(Mid(Text, N, Len(DelimWord)), DelimWord, vbBinaryCompare) = 0 Then
                        I = I + 1
                        If bnegative = True Then
                            Arr(I) = "-" + Mid(Text, Pos1, N - Pos1)
                            bnegative = False
                        Else
                            Arr(I) = Mid(Text, Pos1, N - Pos1)
                        End If
                        Pos1 = N + Len(DelimWord)
                        N = Pos1
                    bnegative = True
                    End If
                End Select
    Next DelimNdx
Next N

If Pos1 <= Len(Text) Then
    I = I + 1
    If bnegative = True Then
        Arr(I) = "-" + Mid(Text, Pos1, N - Pos1)
        bnegative = False
        Else
        Arr(I) = Mid(Text, Pos1, N - Pos1)
    End If
End If

''''''''''''''''''
' chop off unused array elements
''''''''''''''''''
ReDim Preserve Arr(1 To I)
SplitMultiDelimsEX = Arr
    
End Function

Split and write function (arrrggg)

Private Sub Analyse700()
''''''''''''''''''''''''''''''''''''
' Cette fonction a été développé par Julien-Bono Roy                  '
' Toute utilisation de cette fonction doit être préapprouvée,de plus  '
' si vous tentez d'utiliser cette fonction sans une compréhension de  '
' vba, il y a de forte chance que les résultats ne soient pas adéquat '
' Cette fonction sépare et explose les cellules afin d'analyser leur  '
' contenue.                                                           '
''''''''''''''''''''''''''''''''''''


Dim I As Integer, j As Integer, z As Integer
Dim x As Integer, y As Integer
Dim dValeurPlac As Double
Dim strBidon As String

Dim iWorksheet As Integer, strWorksheet As String
Dim strDecCell As String
Dim iacc As Integer

Dim varCellDec() As String
Dim VarCellAgregate() As String
Dim VarCellExplode() As String
Dim VarCellRAnge() As String
Dim VarCellRAnge2() As String
Dim SpreadRAnge As Integer
Dim bidon() As String
Dim startRange As Integer
Dim trash() As String

Dim bPositif As Boolean
Dim bnegative As Boolean
Dim bExitFor As Boolean


Dim bBidon As Boolean

For z = 1 To 10000
    'Attribution de la feuille de travail 700
    
    iWorksheet = ActiveWorkbook.ActiveSheet.Cells(z, 3).Value
    strWorksheet = ActiveWorkbook.ActiveSheet.Name
    
    If iWorksheet >= 701 And iWorksheet < 800 Then
        strDecCell = ActiveWorkbook.Worksheets(strWorksheet).Cells(z, 5).Formula
        If strDecCell = "" Then
        z = z + 1
        End If
        
VarCellAgregate = SplitMultiDelimsEX(strDecCell, "=,+,-", ",")
'For x = 1 To UBound(VarCellAgregate)
'Debug.Print (VarCellAgregate(x))
'Next x
For x = 1 To UBound(VarCellAgregate)
    If UCase(Left(VarCellAgregate(x), 6)) = "SOMME(" Then
        VarCellAgregate(x) = Right(VarCellAgregate(x), Len(VarCellAgregate(x)) - 6)
        
        For j = x To UBound(VarCellAgregate)
            If Right(VarCellAgregate(j), 1) = ")" Then
            VarCellAgregate(j) = Left(VarCellAgregate(j), Len(VarCellAgregate(j)) - 1)
            
            Exit For
            End If
        Next j

    ElseIf UCase(Left(VarCellAgregate(x), 2)) = "-(" Then
        VarCellAgregate(x) = "-" + Right(VarCellAgregate(x), Len(VarCellAgregate(x)) - 2)
        iacc = x
        For j = x To UBound(VarCellAgregate)
            If Right(VarCellAgregate(j), 1) = ")" Then
            VarCellAgregate(j) = Left(VarCellAgregate(j), Len(VarCellAgregate(j)) - 1)
            Exit For
            End If
            iacc = iacc + 1
        Next j
        
        For I = x To iacc
            If VarCellAgregate(I) = VarCellAgregate(x) Then
            I = I + 1
            End If
            If Left(VarCellAgregate(I), 1) = "-" Then
            VarCellAgregate(I) = Right(VarCellAgregate(I), Len(VarCellAgregate(I)) - 1)
            Else
            VarCellAgregate(I) = "-" + VarCellAgregate(I)
            End If
        Next I
    
    ElseIf UCase(Left(VarCellAgregate(x), 7)) = "-SOMME(" Then
        VarCellAgregate(x) = Right(VarCellAgregate(x), Len(VarCellAgregate(x)) - 7)
        iacc = x
        
        For j = x To UBound(VarCellAgregate)
            If Right(VarCellAgregate(j), 1) = ")" Then
            VarCellAgregate(j) = Left(VarCellAgregate(j), Len(VarCellAgregate(j)) - 1)
            Exit For
            End If
            iacc = iacc + 1
        Next j
        For I = x To iacc
            If VarCellAgregate(I) = VarCellAgregate(x) Then
            VarCellAgregate(I) = "-" & VarCellAgregate(I)
            ElseIf Left(VarCellAgregate(I), 1) = "-" Then
            VarCellAgregate(I) = Right(VarCellAgregate(I), Len(VarCellAgregate(I)) - 1)
            Else
            VarCellAgregate(I) = "-" + VarCellAgregate(I)
            End If
        Next I
        
    ElseIf UCase(Left(VarCellAgregate(x), 5)) = "-SUM(" Then
        VarCellAgregate(x) = Right(VarCellAgregate(x), Len(VarCellAgregate(x)) - 5)
        iacc = x
        
        For j = x To UBound(VarCellAgregate)
            If Right(VarCellAgregate(j), 1) = ")" Then
            VarCellAgregate(j) = Left(VarCellAgregate(j), Len(VarCellAgregate(j)) - 1)
            Exit For
            End If
        Next j
        For I = x To iacc
            If VarCellAgregate(I) = VarCellAgregate(x) Then
            VarCellAgregate(I) = "-" & VarCellAgregate(I)
            ElseIf Left(VarCellAgregate(I), 1) = "-" Then
            VarCellAgregate(I) = Right(VarCellAgregate(I), Len(VarCellAgregate(I)) - 1)
            ElseIf Left(VarCellAgregate(I), 1) = "--" Then
                VarCellAgregate(I) = Right(VarCellAgregate(I), Len(VarCellAgregate(I)) - 1)
            Else
            VarCellAgregate(I) = "-" + VarCellAgregate(I)
            'Debug.Print (VarCellAgregate(I))
            End If
        Next I
        
    ElseIf UCase(Left(VarCellAgregate(x), 4)) = "SUM(" Then
        VarCellAgregate(x) = Right(VarCellAgregate(x), Len(VarCellAgregate(x)) - 4)
        
        For j = x To UBound(VarCellAgregate)
            If Right(VarCellAgregate(j), 1) = ")" Then
            VarCellAgregate(j) = Left(VarCellAgregate(j), Len(VarCellAgregate(j)) - 1)
            Exit For
            End If
        Next j
    
    
    End If

Next x
        
For y = 1 To UBound(VarCellAgregate)
    VarCellExplode = Split(VarCellAgregate(y), ":")
        If UBound(VarCellExplode) = -1 Or UBound(VarCellExplode) = 0 Then
        y = y + 1
        Else
        VarCellAgregate(y) = ""
        VarCellRAnge = Split(VarCellExplode(0), "E")
        VarCellRAnge2 = Split(VarCellExplode(1), "E")
        
            If bBidon = True Then
                startRange = SpreadRAnge + 1
                SpreadRAnge = startRange + Val(VarCellRAnge2(1)) - Val(VarCellRAnge(1))
            Else
                startRange = 0
                SpreadRAnge = Val(VarCellRAnge2(1)) - Val(VarCellRAnge(1))
            End If
        End If
    For x = 0 + startRange To SpreadRAnge
        If UBound(VarCellExplode) = -1 Or UBound(VarCellExplode) = 0 Then
        x = x + 1
        Else
        ReDim Preserve bidon(0 To SpreadRAnge) As String
        bBidon = True
        bidon(x) = Left(VarCellExplode(0), Len(VarCellExplode(0)) - Len(VarCellRAnge(1))) & CStr(Val(VarCellRAnge(1)) + x - startRange)
        End If
    Next x
        'bidon(x) = String(val(
        
Next y

'Debug.Print ("     " & z)

'For y = 0 To UBound(bidon)
'    Debug.Print (bidon(y))
'Next y

Sheets.Add.Name = iWorksheet

With ActiveWorkbook.Worksheets(CStr(iWorksheet))
.Cells(1, 3).Value = iWorksheet
.Cells(2, 3).Formula = "=INFO!B1"
.Cells(3, 3).Value = ActiveWorkbook.Worksheets(strWorksheet).Cells(z, 1).Value + ActiveWorkbook.Worksheets(strWorksheet).Cells(z, 2).Value
.Cells(7, 4).Formula = "=INFO!C8"
.Cells(7, 6).Formula = "=INFO!E8"
.Cells(7, 8).Value = "Variations"
.Cells(7, 9).Formula = "%"
End With
If bBidon = True Then
For y = 0 To UBound(bidon)
    Do Until bidon(y) <> "" And bidon(y) <> "+" And bidon(y) <> "-"
        If UBound(bidon) = y Then
            
            bExitFor = True
            Exit Do
        Else
        y = y + 1
        End If
    Loop
    If bExitFor = True Then
        bExitFor = False
        Exit For
    End If
    
    ActiveWorkbook.Worksheets(CStr(iWorksheet)).Cells(y + 13, 4).Formula = "=" & bidon(y)
    trash = Split(bidon(y), "!")
    If Left(bidon(y), 1) = "-" Then
    ActiveWorkbook.Worksheets(CStr(iWorksheet)).Cells(y + 13, 1).Formula = "=" & Right(trash(0), Len(trash(0)) - 1) + "!" + "A" + Right(trash(1), Len(trash(1)) - 1)
    ActiveWorkbook.Worksheets(CStr(iWorksheet)).Cells(y + 13, 2).Formula = "=" & Right(trash(0), Len(trash(0)) - 1) + "!" + "B" + Right(trash(1), Len(trash(1)) - 1)
    Else
    ActiveWorkbook.Worksheets(CStr(iWorksheet)).Cells(y + 13, 1).Formula = "=" & trash(0) + "!" + "A" + Right(trash(1), Len(trash(1)) - 1)
    ActiveWorkbook.Worksheets(CStr(iWorksheet)).Cells(y + 13, 2).Formula = "=" & trash(0) + "!" + "B" + Right(trash(1), Len(trash(1)) - 1)
    End If
    
Next y
End If

For y = 1 To UBound(VarCellAgregate)
    Do Until VarCellAgregate(y) <> "" And VarCellAgregate(y) <> "+" And VarCellAgregate(y) <> "-"
        If UBound(VarCellAgregate) = y Then
            bExitFor = True
            Exit Do
        Else
        y = y + 1
        End If
    Loop
    If bExitFor = True Then
        bExitFor = False
        Exit For
    End If
    ActiveWorkbook.Worksheets(CStr(iWorksheet)).Cells(y + 13 + UBound(bidon), 4).Formula = "=" & VarCellAgregate(y)
    trash = Split(VarCellAgregate(y), "!")
    
    If Left(VarCellAgregate(y), 1) = "-" Then
    ActiveWorkbook.Worksheets(CStr(iWorksheet)).Cells(y + 13 + UBound(bidon), 1).Formula = "=" & Right(trash(0), Len(trash(0)) - 1) + "!" + "A" + Right(trash(1), Len(trash(1)) - 1)
    ActiveWorkbook.Worksheets(CStr(iWorksheet)).Cells(y + 13 + UBound(bidon), 2).Formula = "=" & Right(trash(0), Len(trash(0)) - 1) + "!" + "B" + Right(trash(1), Len(trash(1)) - 1)
    Else
    ActiveWorkbook.Worksheets(CStr(iWorksheet)).Cells(y + 13 + UBound(bidon), 1).Formula = "=" & trash(0) + "!" + "A" + Right(trash(1), Len(trash(1)) - 1)
    ActiveWorkbook.Worksheets(CStr(iWorksheet)).Cells(y + 13 + UBound(bidon), 2).Formula = "=" & trash(0) + "!" + "B" + Right(trash(1), Len(trash(1)) - 1)
    End If
Next y
'For y = 1 To UBound(VarCellAgregate)
'    Debug.Print (VarCellAgregate(y))
'Next y



    End If
    
ActiveWorkbook.Worksheets(strWorksheet).Activate


ReDim Preserve bidon(0) As String
bBidon = False
Next z

MsgBox ("Macro terminé, assurez-vous de bien concilier les placements pour qu'il n'y ait pas d'erreur")

    

'Julien-Bono Roy, 2011, les montants doivent être conciliés suite à l'exécution de la macro
End Sub

"Knowing that you know is the greatest sign of stupidity, knowing that you are ignorant is the best proof of intelligence.

 

[UnsolvedCoding]

One thing I would suggest is to go back and write comments through the code explaining what each line does. The more comments the better.

The reason I say this is because it makes you think about what you're doing and often helps solve problems. The other reason for this is so that you don't foget what you did or why.

For me, reading this is much harder trying to figure out whats going on then reading a comment on what its supposed to do and then working from that point.

 

[ItIsHardToProgram]

You are 100% right! I got extremly lazy and wanted to comment the whole thing, but for the sake of the exercise I will comment this in english for the reader, I understand he can feel extremly dizzy from reading the whole code ><

"Knowing that you know is the greatest sign of stupidity, knowing that you are ignorant is the best proof of intelligence.

 

[UnsolvedCoding]

Oh ya, one other thing. If using an array dimension it as an array.

 

[SkipVought]

What is the requirement logic, in prose, for this?

I don't want to reverse engineer your code and ASSUME that it can state the logic.

NO CODE PLEASE.

Skip,
[sub]
Just traded in my old subtlety...
for a NUANCE![/sub]

 

[ItIsHardToProgram]

Here is the commented code (kindof? D

Function SplitMultiDelimsEX(Text As String, DelimStrings As String, _
    DelimStringsSep As String) As String()
'''''''''''''''''''''''''''''''''''
' SplitMultiDelimsEX
' This function is like VBA's Split function or the SplitMultiDelims
' function, also in this module. It accepts any number of multiple-
' character delimiter strings and splits Text into substrings based
' on the delimiter strings. It returns an unallocated array if Text
' is empty, a single-element array if DelimStrings is empty, or a
' 1 or greater element array if Text was successfully split into
' substrings based on the DelimStrings delimiters.
'''''''''''''''''''''''''''''''''''
Dim Pos1 As Long
Dim N As Long
Dim M As Long
Dim Arr() As String
Dim I As Long
Dim DelimWords() As String
Dim DelimNdx As Long
Dim DelimWord As String
Dim bnegative As Boolean

'''''''''''''''
' if Text is empty, get out
'''''''''''''''
If Len(Text) = 0 Then
    Exit Function
End If

''''''''''''''''''''''''''
' if there are no delimiters, return the whole text
''''''''''''''''''''''''''
If DelimStrings = vbNullString Then
    SplitMultiDelimsEX = Array(Text)
    Exit Function
End If

'''''''''''''''''''''
' if there is no delim separator, get out
'''''''''''''''''''''
If DelimStringsSep = vbNullString Then
    Exit Function
End If

DelimWords = Split(DelimStrings, DelimStringsSep)
'If IsArrayAllocated(DelimWords) = False Then
'    Exit Function
'End If

''''''''''''''''''''''''
' oversize the array, we'll shrink it later so
' we don't need to use Redim Preserve
''''''''''''''''''''''''
ReDim Arr(1 To Len(Text))

I = 0
N = 0
Pos1 = 1

For N = Pos1 To Len(Text)
    For DelimNdx = LBound(DelimWords) To UBound(DelimWords)
        DelimWord = DelimWords(DelimNdx)
        
            'Filter the delimiters in order to not return useless "=" in cells and in order to keep
            'the "-" of a specific arithmetic, including the negative of sums, wich will be attributed
            'to the range of cell later in the code
            
            Select Case DelimWord
                Case "="
                    If StrComp(Mid(Text, N, Len(DelimWord)), DelimWord, vbBinaryCompare) = 0 Then
                        I = I + 1
                        If bnegative = True Then
                            Arr(I) = "-" + Mid(Text, Pos1, N - Pos1)
                            bnegative = False
                        Else
                            Arr(I) = Mid(Text, Pos1, N - Pos1)
                        End If
                        Pos1 = N + Len(DelimWord)
                        N = Pos1
                    End If
                Case "+"
                    If StrComp(Mid(Text, N, Len(DelimWord)), DelimWord, vbBinaryCompare) = 0 Then
                        I = I + 1
                        If bnegative = True Then
                            Arr(I) = "-" + Mid(Text, Pos1, N - Pos1)
                            bnegative = False
                        Else
                            Arr(I) = Mid(Text, Pos1, N - Pos1)
                        End If
                        Pos1 = N + Len(DelimWord)
                        N = Pos1
                    End If
                Case "-"
                    If StrComp(Mid(Text, N, Len(DelimWord)), DelimWord, vbBinaryCompare) = 0 Then
                        I = I + 1
                        If bnegative = True Then
                            Arr(I) = "-" + Mid(Text, Pos1, N - Pos1)
                            bnegative = False
                        Else
                            Arr(I) = Mid(Text, Pos1, N - Pos1)
                        End If
                        Pos1 = N + Len(DelimWord)
                        N = Pos1
                    bnegative = True
                    End If
                End Select
    Next DelimNdx
Next N

'Add the - to a specific filtered string in order to keep the correct arithmetic

If Pos1 <= Len(Text) Then
    I = I + 1
    If bnegative = True Then
        Arr(I) = "-" + Mid(Text, Pos1, N - Pos1)
        bnegative = False
        Else
        Arr(I) = Mid(Text, Pos1, N - Pos1)
    End If
End If

''''''''''''''''''
' chop off unused array elements
''''''''''''''''''
ReDim Preserve Arr(1 To I)
SplitMultiDelimsEX = Arr
    
End Function

HEre is the other code commented:

Private Sub Analyse700()
''''''''''''''''''''''''''''''''''''
' Cette fonction a été développé par Julien-Bono Roy                  '
' Toute utilisation de cette fonction doit être préapprouvée,de plus  '
' si vous tentez d'utiliser cette fonction sans une compréhension de  '
' vba, il y a de forte chance que les résultats ne soient pas adéquat '
' Cette fonction sépare et explose les cellules afin d'analyser leur  '
' contenue.                                                           '
''''''''''''''''''''''''''''''''''''


Dim I As Integer, j As Integer, z As Integer
Dim x As Integer, y As Integer
Dim dValeurPlac As Double
Dim strBidon As String

Dim iWorksheet As Integer, strWorksheet As String
Dim strDecCell As String
Dim iacc As Integer

Dim varCellDec() As String
Dim VarCellAgregate() As String
Dim VarCellExplode() As String
Dim VarCellRAnge() As String
Dim VarCellRAnge2() As String
Dim SpreadRAnge As Integer
Dim bidon() As String
Dim startRange As Integer
Dim trash() As String

Dim bPositif As Boolean
Dim bnegative As Boolean
Dim bExitFor As Boolean


Dim bBidon As Boolean

For z = 1 To 10000
    'lazy way of doing a for each....
    'Search through the active sheet in order to find data to explode
    
    iWorksheet = ActiveWorkbook.ActiveSheet.Cells(z, 3).Value
    strWorksheet = ActiveWorkbook.ActiveSheet.Name
    
    'If there is a reference for a sheet in the correct column, then start procedure to explode cell in a new sheet
    
    If iWorksheet >= 701 And iWorksheet < 800 Then
        strDecCell = ActiveWorkbook.Worksheets(strWorksheet).Cells(z, 5).Formula
        
        'If the current cell has no formula, then move on to the next cell in order to explode it
        'As I am writing the comment I realize this specefic "if" really does nothing for the code since
        'if the cell contains "", and the next cell contains "", it will still run the procedure for a cell containing ""
        'thus taking more time...
        
        If strDecCell = "" Then
        z = z + 1
        End If
    
'Call the procedure splitmultidelimsEx, wich splits the cell with specific delimiters, that can be multiple characters


VarCellAgregate = SplitMultiDelimsEX(strDecCell, "=,+,-", ",")



'Chop off any useless parts of a specific string, besides the Cell range, or the cell, and the arithmetic (-)
'The reason you see "somme" is that I use a french version of excel. Cells wont contain any other formula than
'sum or somme

For x = 1 To UBound(VarCellAgregate)

    If UCase(Left(VarCellAgregate(x), 6)) = "SOMME(" Then
    
        'Chop off the formula of the string in order to have constant range and not excess wording
        
        VarCellAgregate(x) = Right(VarCellAgregate(x), Len(VarCellAgregate(x)) - 6)
        
        For j = x To UBound(VarCellAgregate)
        
            'Find the end of the function and remove the last parantheses
            
            If Right(VarCellAgregate(j), 1) = ")" Then
            VarCellAgregate(j) = Left(VarCellAgregate(j), Len(VarCellAgregate(j)) - 1)
            
            Exit For
            End If
        Next j

    ElseIf UCase(Left(VarCellAgregate(x), 2)) = "-(" Then
        VarCellAgregate(x) = "-" + Right(VarCellAgregate(x), Len(VarCellAgregate(x)) - 2)
        iacc = x
        
        For j = x To UBound(VarCellAgregate)
        
        'find the last parantheses, remove it, and apply the correct "negative" to the whole range of cells in the specific
        'group
        
            If Right(VarCellAgregate(j), 1) = ")" Then
            VarCellAgregate(j) = Left(VarCellAgregate(j), Len(VarCellAgregate(j)) - 1)
            Exit For
            End If
            iacc = iacc + 1
        Next j
        
        'Since the following cell references were in a negative parenthese, invert the signs.
        
        For I = x To iacc
            If VarCellAgregate(I) = VarCellAgregate(x) Then
            I = I + 1
            End If
            If Left(VarCellAgregate(I), 1) = "-" Then
            VarCellAgregate(I) = Right(VarCellAgregate(I), Len(VarCellAgregate(I)) - 1)
            Else
            VarCellAgregate(I) = "-" + VarCellAgregate(I)
            End If
        Next I
    
    ElseIf UCase(Left(VarCellAgregate(x), 7)) = "-SOMME(" Then
        VarCellAgregate(x) = Right(VarCellAgregate(x), Len(VarCellAgregate(x)) - 7)
        iacc = x
        
         'Chop off the formula of the string in order to have constant range and not excess wording
        
        For j = x To UBound(VarCellAgregate)
        
        'find the last parantheses, remove it, and apply the correct "negative" to the whole range of cells in the specific
        'group
        
            If Right(VarCellAgregate(j), 1) = ")" Then
            VarCellAgregate(j) = Left(VarCellAgregate(j), Len(VarCellAgregate(j)) - 1)
            Exit For
            End If
            iacc = iacc + 1
        Next j
        
        'Since the following cell references were in a negative parenthese, invert the signs.
        For I = x To iacc
            If VarCellAgregate(I) = VarCellAgregate(x) Then
            VarCellAgregate(I) = "-" & VarCellAgregate(I)
            ElseIf Left(VarCellAgregate(I), 1) = "-" Then
            VarCellAgregate(I) = Right(VarCellAgregate(I), Len(VarCellAgregate(I)) - 1)
            
            Else
            VarCellAgregate(I) = "-" + VarCellAgregate(I)
            End If
        Next I
        
    ElseIf UCase(Left(VarCellAgregate(x), 5)) = "-SUM(" Then
        VarCellAgregate(x) = Right(VarCellAgregate(x), Len(VarCellAgregate(x)) - 5)
        iacc = x
        
        For j = x To UBound(VarCellAgregate)
            If Right(VarCellAgregate(j), 1) = ")" Then
            VarCellAgregate(j) = Left(VarCellAgregate(j), Len(VarCellAgregate(j)) - 1)
            Exit For
            End If
        Next j
        
        'Since the following cell references were in a negative parenthese, invert the signs.
        For I = x To iacc
        
            If VarCellAgregate(I) = VarCellAgregate(x) Then
            
            VarCellAgregate(I) = "-" & VarCellAgregate(I)
            
            ElseIf Left(VarCellAgregate(I), 1) = "-" Then
            VarCellAgregate(I) = Right(VarCellAgregate(I), Len(VarCellAgregate(I)) - 1)
            
            ElseIf Left(VarCellAgregate(I), 1) = "--" Then
                VarCellAgregate(I) = Right(VarCellAgregate(I), Len(VarCellAgregate(I)) - 1)
            Else
            VarCellAgregate(I) = "-" + VarCellAgregate(I)

            End If
        Next I
        
    ElseIf UCase(Left(VarCellAgregate(x), 4)) = "SUM(" Then
        VarCellAgregate(x) = Right(VarCellAgregate(x), Len(VarCellAgregate(x)) - 4)
        
        For j = x To UBound(VarCellAgregate)
            If Right(VarCellAgregate(j), 1) = ")" Then
            VarCellAgregate(j) = Left(VarCellAgregate(j), Len(VarCellAgregate(j)) - 1)
            Exit For
            End If
        Next j
    
    
    End If

Next x

'Explode any Sum formula, in order to keep the range of the specific formula, without compromising multiple range
'in the specific form formula, i.e. sum(E12:E24 + E35:E68 - E69)

For y = 1 To UBound(VarCellAgregate)
    VarCellExplode = Split(VarCellAgregate(y), ":")
        
        'If there is no delimited range, skip to the next string
        
        If UBound(VarCellExplode) = -1 Or UBound(VarCellExplode) = 0 Then
        y = y + 1
        
        Else
        
        'If there is, find the specific numbers attributed to the cell and explode the range
        
        VarCellAgregate(y) = ""
        VarCellRAnge = Split(VarCellExplode(0), "E")
        VarCellRAnge2 = Split(VarCellExplode(1), "E")
        
            If bBidon = True Then
                startRange = SpreadRAnge + 1
                SpreadRAnge = startRange + Val(VarCellRAnge2(1)) - Val(VarCellRAnge(1))
            Else
                startRange = 0
                SpreadRAnge = Val(VarCellRAnge2(1)) - Val(VarCellRAnge(1))
            End If
        End If

'In order to keep the whole array of the current cell, lets say there are multiple range, add the start range to the
'starting range

    For x = 0 + startRange To SpreadRAnge
        If UBound(VarCellExplode) = -1 Or UBound(VarCellExplode) = 0 Then
        x = x + 1
        Else
        
        'In order to not have to oversize the array
        
        ReDim Preserve bidon(0 To SpreadRAnge) As String
        
        'In order to tell my procedure that there is currently a range to write onto the sheet.
        bBidon = True
        bidon(x) = Left(VarCellExplode(0), Len(VarCellExplode(0)) - Len(VarCellRAnge(1))) & CStr(Val(VarCellRAnge(1)) + x - startRange)
        End If
    Next x

        
Next y



'Very lazy writing procedure that creates a new sheet with standart information.

Sheets.Add.Name = iWorksheet

With ActiveWorkbook.Worksheets(CStr(iWorksheet))
.Cells(1, 3).Value = iWorksheet
.Cells(2, 3).Formula = "=INFO!B1"
.Cells(3, 3).Value = ActiveWorkbook.Worksheets(strWorksheet).Cells(z, 1).Value + ActiveWorkbook.Worksheets(strWorksheet).Cells(z, 2).Value
.Cells(7, 4).Formula = "=INFO!C8"
.Cells(7, 6).Formula = "=INFO!E8"
.Cells(7, 8).Value = "Variations"
.Cells(7, 9).Formula = "%"
End With

'Since there is a range that was exploded, paste the specific range on the sheet

If bBidon = True Then
For y = 0 To UBound(bidon)
    Do Until bidon(y) <> "" And bidon(y) <> "+" And bidon(y) <> "-"
        If UBound(bidon) = y Then
            
            bExitFor = True
            Exit Do
        Else
        y = y + 1
        End If
    Loop
    If bExitFor = True Then
        bExitFor = False
        Exit For
    End If

'Paste the correct information on the new sheet created from the reference i.e. iworksheet

    ActiveWorkbook.Worksheets(CStr(iWorksheet)).Cells(y + 13, 4).Formula = "=" & bidon(y)
    trash = Split(bidon(y), "!")
    If Left(bidon(y), 1) = "-" Then
    ActiveWorkbook.Worksheets(CStr(iWorksheet)).Cells(y + 13, 1).Formula = "=" & Right(trash(0), Len(trash(0)) - 1) + "!" + "A" + Right(trash(1), Len(trash(1)) - 1)
    ActiveWorkbook.Worksheets(CStr(iWorksheet)).Cells(y + 13, 2).Formula = "=" & Right(trash(0), Len(trash(0)) - 1) + "!" + "B" + Right(trash(1), Len(trash(1)) - 1)
    Else
    ActiveWorkbook.Worksheets(CStr(iWorksheet)).Cells(y + 13, 1).Formula = "=" & trash(0) + "!" + "A" + Right(trash(1), Len(trash(1)) - 1)
    ActiveWorkbook.Worksheets(CStr(iWorksheet)).Cells(y + 13, 2).Formula = "=" & trash(0) + "!" + "B" + Right(trash(1), Len(trash(1)) - 1)
    End If
    
Next y
End If

'paste the rest of the information of the cell on the new sheet

For y = 1 To UBound(VarCellAgregate)
    Do Until VarCellAgregate(y) <> "" And VarCellAgregate(y) <> "+" And VarCellAgregate(y) <> "-"
        If UBound(VarCellAgregate) = y Then
            bExitFor = True
            Exit Do
        Else
        y = y + 1
        End If
    Loop
    If bExitFor = True Then
        bExitFor = False
        Exit For
    End If
    ActiveWorkbook.Worksheets(CStr(iWorksheet)).Cells(y + 13 + UBound(bidon), 4).Formula = "=" & VarCellAgregate(y)
    trash = Split(VarCellAgregate(y), "!")
    
    If Left(VarCellAgregate(y), 1) = "-" Then
    ActiveWorkbook.Worksheets(CStr(iWorksheet)).Cells(y + 13 + UBound(bidon), 1).Formula = "=" & Right(trash(0), Len(trash(0)) - 1) + "!" + "A" + Right(trash(1), Len(trash(1)) - 1)
    ActiveWorkbook.Worksheets(CStr(iWorksheet)).Cells(y + 13 + UBound(bidon), 2).Formula = "=" & Right(trash(0), Len(trash(0)) - 1) + "!" + "B" + Right(trash(1), Len(trash(1)) - 1)
    Else
    ActiveWorkbook.Worksheets(CStr(iWorksheet)).Cells(y + 13 + UBound(bidon), 1).Formula = "=" & trash(0) + "!" + "A" + Right(trash(1), Len(trash(1)) - 1)
    ActiveWorkbook.Worksheets(CStr(iWorksheet)).Cells(y + 13 + UBound(bidon), 2).Formula = "=" & trash(0) + "!" + "B" + Right(trash(1), Len(trash(1)) - 1)
    End If
Next y


    End If
    
'Reactivate the first worksheet in order to not have any errors.

ActiveWorkbook.Worksheets(strWorksheet).Activate

'Clear the array, reset the boolean's

ReDim Preserve bidon(0) As String
bBidon = False
Next z

'Msg that says that the macro is done.

MsgBox ("Macro terminé, assurez-vous de bien concilier les placements pour qu'il n'y ait pas d'erreur")

    

'Julien-Bono Roy, 2011, les montants doivent être conciliés suite à l'exécution de la macro
End Sub

"Knowing that you know is the greatest sign of stupidity, knowing that you are ignorant is the best proof of intelligence.

 

[ItIsHardToProgram]

Alright skip, back to step one!

The logic is fairly simple.

We have a worksheet that currently has multiple lines, and each line is a grouping of multiple lines in another specific worksheet.

The grouping is always done in arithmetic fasion: (i.e., sum(), +, -(), +(), -sum(), etc...) Any type of arithmetic formula might be done considering that multiple users attribute groups on different worksheets.

Now, the goal is to take the specific worksheet that has all the grouping, and for each line specified by the user, create a seperate worksheet. On the worksheet, there is a standart title etc..., and then, every single cell in the arithmetic formula of the grouping, should be a line, with the correct value in order to reconciliate the overall value of the specific grouping (if that makes any sort of sense to you...)

Let me image this for you:
column ref cell
704 =Sum(BV!E62:E122)-(BV!E133-BV!E134)+(BV!E24-BV!E25)-sum(BV!E100:E144-BV!E25)

This should return on a new sheet called 704 (order is not important, it can be random)

=BV!E62
=BV!E63
...
=BV!E122
=-BV!E133
=-BV!E134
=BV!E24
=-BV!E25
=-BV!E100
=-BV!E101
...
=-BV!E144
=BV!E25


There are a few other informations that should be added on the left columns of the specific numbers, that is done by "stripping" the cell into a number, and applying the correct prefixe (i.e. BV!A) to the number.


"Knowing that you know is the greatest sign of stupidity, knowing that you are ignorant is the best proof of intelligence.

 

[UnsolvedCoding]

First thing I would do is go to using a "dynamic" array. In otherwords declare your array and a long. The way it works is you create a loop with an exit point in the loop so that when the criteria is meet the information is saved into the array.

Instead of doing Range("A1").value the one is replaced with the value of your long which would read something like this Range("A" & K).value and K will increase by your setting each time you loop.

So, off the top of my head, you would have something like this -

Dim Math_Array()

Dim K as long

' This starts your array at the number one. I start at one or two, depending if I have a header row, so that I can duplicate the array number and the line number with one variable. This assumes no header row.

K = 1

Do

' Get the array ready to be used
Redim preserve Math_Array(K)

' Look for your critera
If trim(range("A" & K).value) = "2+2" then

' Put the information you want into the array
Math_Array(K)=trim(range("A" & K).Value)

End if

' Go down one row and increase to the next array value
K = K + 1

' If you have no value you are at the end the list and need to exit the loop
if trim(range("A" & K).value = "" then exit do

Loop


To get the information from the array use

Do

' If you hit a number higher than in the array exit loop
if k > ubound Math_Array exit do

' Put the value in a cell
Range("A" & K).value = Math_Array(K)

'Increase row and array by one
k=k+1

loop

This is off the top of my head so I may have forgotten something along the way but you should be able to pick up on the gist of whats going on.

 

[UnsolvedCoding]

By the way, I did see that you are using arrays, it just looks like the code could be reduced by redoing the arrays.

What I mean is this - While you are using arrays it doesn't appear that the full potentional is being tapped. Also I would suggest trying a multi-dimensional array and seeing if that works.

Have to finish my thought later I am being called to address an issue.

 

[ItIsHardToProgram]

Besides the few "lazy" for's this code relies on alot of arrays,

I am having trouble understanding how multi-dimensional arrays would help my cause, of course it would limit the quantity of arrays, but every single operation on the string would still need ot be done exactly how it is done right now.

Is having multiple array such a big issue for machines executing the code, or for the average reader for that mather,

tyvm

Julien,

"Knowing that you know is the greatest sign of stupidity, knowing that you are ignorant is the best proof of intelligence.

 

[Andrzejek]

It is probably just me, but I would also suggest changing (well, actually: sticking with one way of) naming your variables. And avoiding reserved words like Text (Name, Date, Select, etc.)
So, I would do:

Function SplitMultiDelimsEX([blue]str[/blue]Text As String, [blue]str[/blue]Delim As String, _
    [blue]str[/blue]DelimSep As String) As String()

And you already use some pre-fixes for your variables, but you are not consistent. Either decide to prefix Strings with str or just s, Integers with int or just I, Long with lng or l, and stick with it everywhere.

Dim strBidon As String
Dim strDecCell As String
Dim iacc As Integer

As for Boolean (either bln or b), it is a good idea to use a word IS in the name of it, so instead of

Dim bPositif As Boolean
Dim bnegative As Boolean

You end up with something like

Dim b[blue]Is[/blue]Positif As Boolean
Dim b[blue]Is[/blue]Negative As Boolean

A lot easier to read and understand, IMHO, of course….


Have fun.

---- Andy

 

[ItIsHardToProgram]

Thanks! Yeah Andy, I again am 100% behind what you are saying, the reserved names variable werent entered by me, but I should definatly correct those, and for the sticking to 1 way of naming variables, you are right, when you finish something friday, sometimes theres a few slipthrough.

Thanks a bunch.

"Knowing that you know is the greatest sign of stupidity, knowing that you are ignorant is the best proof of intelligence.