Function to summarize text in Vba Excel

Question

Now I'm using MS Excel 2019. I desire to make function to get text at Summary Steps column and Sumary Values column from Steps and Values Column It's described as .

I tried with this function. However, It doesn't work at all

Function Congdoan_Time(Congdoan As Range, Time As Range, gtri As Boolean) As String

Dim xValue, TimeValue As String
Dim xChar As String
Dim xOutValue, xTimeValue As String

xValue = Congdoan.Value
TimeValue = Time.Value
Dim arr, timearr As Variant
Dim text, texttime As String
Dim nextarr As Variant
arr = Split(xValue, ",")
timearr = Split(TimeValue, "-")
Dim i As Long
Dim vallue As Variant
vallue = timearr(0)
  For i = LBound(arr) To UBound(arr) - 1
        If arr(i) = arr(i + 1) And i < UBound(arr) - 1 Then
        vallue = Val(vallue) + Val(timearr(i + 1))
         End If
        If arr(i) = arr(i + 1) And i = UBound(arr) - 1 Then
         End If
         If arr(i) <> arr(i + 1) Then
         xOutValue = xOutValue & "," & arr(i)
         xTimeValue = xTimeValue & "-" & vallue
        vallue = Val(timearr(i + 1))
        End If
    Next i

If xOutValue = "" Then
xOutValue = Join(arr, ",")
xTimeValue = vallue
End If

text = Right(xOutValue, Len(xOutValue) - 1)
nextarr = Split(text, ",")
If arr(UBound(arr)) <> nextarr(UBound(nextarr)) Then
text = text & "," & arr(UBound(arr))
xTimeValue = xTimeValue & "-" & Val(vallue) + Val(timearr(UBound(arr)))

End If
If gtri = True Then
Congdoan_Time = text
Else
Congdoan_Time = xTimeValue
End If
End Function

Formula at Sumary Steps Column

at Sumary Values Column

Please help to make another funtion that's work for me Thank you

JvdV · Accepted Answer · 2022-06-08T17:01:31.030

My two cents using a dictionary:

Function Summary(steps As String, vals As String, pick As Boolean) As String

Dim arr_steps As Variant, arr_vals As Variant
Dim new_steps() As Variant, new_vals() As Variant

arr_steps = Split(steps, ",")
arr_vals = Split(vals, "-")

ReDim new_steps(UBound(arr_steps))
ReDim new_vals(UBound(arr_steps))

For x = 0 To UBound(arr_steps)
    If x = 0 Then
        new_steps(x) = arr_steps(x)
        new_vals(x) = arr_vals(x)
    ElseIf arr_steps(x) = arr_steps(x - 1) Then
        new_vals(x) = CDbl(new_vals(x - 1)) + CDbl(arr_vals(x))
        new_vals(x - 1) = ""
    Else
        new_steps(x) = arr_steps(x)
        new_vals(x) = arr_vals(x)
    End If
Next

If pick Then
    Summary = Join(new_steps, ",")
Else
    Summary = Join(new_vals, "-")
End If

With CreateObject("VBScript.RegExp")
    .Global = True
    .Pattern = "(?:^-+|[-,]+([-,])|,+$)"
    Summary = .Replace(Summary, "$1")
End With

End Function

Formula in C1:

=Summary(A1,B1,1)

Formula in D1:

=Summary(A1,B1,0)

Note: My locale uses decimal-comma instead of point. It should work out fine if yours is using dots. I just had to change these in the input.

I don't think using dictionary to handle this problem. Because It allows getting a unique set of values. You also see the 4th row of the first my photo in the question I mentioned Steps is `Y,V,Y,Y,V` and values is '1-2-5-3-1' Then what I'm expecting steps is `Y,V,Y,V` and values is `1-2-8-1` . I believe that you can have another way to solve it. Thank you — banana, Jun 08 '22 at 14:16
@banana, you are right. Oversight from my end. Answer edited accordingly. — JvdV, Jun 08 '22 at 17:01

score 0 · Answer 2 · answered Jun 08 '22 at 17:25

I'm not sure I fully understand the question but looking at your examples it looks like you want to deduplicate a comma delimited string but only where duplicates are in series. Something like this does that quite optimally:

Function SerialDedupe(ByVal s As String) As String
  Dim v: v = Split(s, ",")
  Dim iLB As Long: iLB = LBound(v)
  Dim index As Long: index = iLB
  Dim i As Long
  For i = iLB + 1 To UBound(v)
    If v(i) <> v(index) Then
      index = index + 1
      v(index) = v(i)
    End If
  Next
  ReDim Preserve v(iLB To index)
  SerialDedupe = Join(v, ",")
End Function

Tests:

1,2,2,2,3,3,2 ==> 1,2,3,2
A,B,B,C,B,B,C,D,B,C,B,A,A,B ==> A,B,C,B,C,D,B,C,B,A,B
1,2,2 ==> 1,2
1,1,2 ==> 1,2
1,2   ==> 1,2
1     ==> 1

Function to summarize text in Vba Excel

2 Answers2