Make code more variable

[swaggerbox]

Hi guys, I need help to modify the macro below and make it more dynamic. The macro iterates to 8 claims only. How do I change this so that it iterates to hundreds of claims without having to manually each claim.

Sub claimgen()

wdString = ActiveSheet.TextBox1.Text
wdString = Mid(wdString, InStr(wdString, "[CLAIM 0001]"), Len(wdString))
wdString = Left(wdString, InStr(wdString, "[DESCRIPTION]") - 1)

'claim 1
clm1 = Mid(wdString, InStr(wdString, "[CLAIM 0001]") + 14, Len(wdString))

If InStr(clm1, "[CLAIM 0002]") > 0 Then
    clm1 = Left(clm1, InStr(clm1, "[CLAIM 0002]") - 1)
End If

'claim 2
If InStr(wdString, "[CLAIM 0002]") > 0 Then
    clm2 = Mid(wdString, InStr(wdString, "[CLAIM 0002]") + 14, Len(wdString))
    
    If InStr(clm2, "[CLAIM 0003]") > 0 Then
        clm2 = Left(clm2, InStr(clm2, "[CLAIM 0003]") - 1)
    End If

End If

    If InStr(clm2, "according to claim") > 0 Then
        clm2 = vbTab & clm2
    End If
    
'claim 3
If InStr(wdString, "[CLAIM 0003]") > 0 Then
    clm3 = Mid(wdString, InStr(wdString, "[CLAIM 0003]") + 14, Len(wdString))
    
    If InStr(clm3, "[CLAIM 0004]") > 0 Then
        clm3 = Left(clm3, InStr(clm3, "[CLAIM 0004]") - 1)
    End If

End If

    If InStr(clm3, "according to claim") > 0 Then
        clm3 = vbTab & clm3
    End If


'claim 4
If InStr(wdString, "[CLAIM 0004]") > 0 Then
    clm4 = Mid(wdString, InStr(wdString, "[CLAIM 0004]") + 14, Len(wdString))
    
    If InStr(clm4, "[CLAIM 0005]") > 0 Then
        clm4 = Left(clm4, InStr(clm4, "[CLAIM 0005]") - 1)
    End If

End If

    If InStr(clm4, "according to claim") > 0 Then
        clm4 = vbTab & clm4
    End If

'claim 5
If InStr(wdString, "[CLAIM 0005]") > 0 Then
    clm5 = Mid(wdString, InStr(wdString, "[CLAIM 0005]") + 14, Len(wdString))
    
    If InStr(clm5, "[CLAIM 0006]") > 0 Then
        clm5 = Left(clm5, InStr(clm5, "[CLAIM 0006]") - 1)
    End If

End If

    If InStr(clm5, "according to claim") > 0 Then
        clm5 = vbTab & clm5
    End If
    
    

'claim 6
If InStr(wdString, "[CLAIM 0006]") > 0 Then
    clm6 = Mid(wdString, InStr(wdString, "[CLAIM 0006]") + 14, Len(wdString))
    
    If InStr(clm6, "[CLAIM 0007]") > 0 Then
        clm6 = Left(clm6, InStr(clm6, "[CLAIM 0007]") - 1)
    End If

End If

    If InStr(clm6, "according to claim") > 0 Then
        clm6 = vbTab & clm6
    End If

'claim 7
If InStr(wdString, "[CLAIM 0007]") > 0 Then
    clm7 = Mid(wdString, InStr(wdString, "[CLAIM 0007]") + 14, Len(wdString))
    
    If InStr(clm7, "[CLAIM 0008]") > 0 Then
        clm7 = Left(clm7, InStr(clm7, "[CLAIM 0008]") - 1)
    End If

End If

    If InStr(clm7, "according to claim") > 0 Then
        clm7 = vbTab & clm7
    End If

'claim 8
If InStr(wdString, "[CLAIM 0008]") > 0 Then
    clm8 = Mid(wdString, InStr(wdString, "[CLAIM 0008]") + 14, Len(wdString))
    
    If InStr(clm8, "[CLAIM 0009]") > 0 Then
        clm8 = Left(clm8, InStr(clm8, "[CLAIM 0009]") - 1)
    End If

End If

    If InStr(clm8, "according to claim") > 0 Then
        clm8 = vbTab & clm8
    End If
    
ActiveSheet.TextBox2.Text = clm1 & vbNewLine & clm2 & vbNewLine & clm3 & vbNewLine & clm4 & vbNewLine & clm5 & vbNewLine & clm6 & vbNewLine & clm7 & vbNewLine & clm8


End Sub

[snb]

Claims in Textboxes ?

Please post a sample workbook.

[swaggerbox]

I have attached a sample workbook. The macro works only up to claim#8. Would need to modify to iterate to more than 8. Would need it to be dynamic so I don't have to manually input the claim number and the number of claims

[p45cal]

Sub blah()
wdstring = ActiveSheet.TextBox1.Text
wdstring = Mid(wdstring, InStr(wdstring, "[CLAIM 0001]"), Len(wdstring))
wdstring = Left(wdstring, InStr(wdstring, "[DESCRIPTION]") - 1)
myStrings = Split(wdstring, "[CLAIM")
For Each myString In myStrings
  If InStr(myString, "]") > 0 Then
    myStrs = Split(myString, "]")
    ResultStr = ResultStr & vbLf & vbLf & IIf(InStr(myStrs(1), "according to claim") > 0, vbTab, Empty) & Application.Clean(Application.Trim(myStrs(1)))
  End If
Next myString
ActiveSheet.TextBox2.Text = Mid(ResultStr, 3)
End Sub

[snb]

Private Sub CommandButton1_Click()
  Sheet1.TextBox2.Text = Join(Filter(Split(Sheet1.TextBox1.Text, vbLf), "[", 0), vbLf & vbLf)
End Sub

[Paul_Hossler]

One way

Option Explicit


Sub ClaimGen()
    Dim sIn As String, sOut As String
    Dim v As Variant
    Dim i As Long
    
    sIn = ActiveSheet.TextBox1.Text
    sIn = Trim(Replace(sIn, "[CLAIMS]", vbNullString))
    sIn = Application.WorksheetFunction.Clean(sIn)
    
    
    v = Split(sIn, "[CLAIM")
    
    sOut = vbTab    '   I wanted to indent to match


    For i = LBound(v) To UBound(v)
        If Len(v(i)) > 0 Then
            v(i) = Right(v(i), Len(v(i)) - 6)
        
            If InStr(v(i), "according to claim") > 0 Then v(i) = vbTab & v(i)   '   not sure why but left it in
        
            sOut = sOut & v(i)

            If i < UBound(v) Then sOut = sOut & vbLf
        End If
    Next


    ActiveSheet.TextBox2.Text = sOut


End Sub

[swaggerbox]

p45cal, snb, paul: can't thank you enough. these are splendid solutions. But i have to commend p45cal because it was only his solution that included "indentations" or tabs. If the claim has the word "according to claim" then it should add a tab to that particular claim.

[snb]

In that case:

Private Sub CommandButton1_Click()
  sn = Filter(Split(Sheet1.TextBox1.Text, vbLf), "[", 0)
  For j = 0 To UBound(sn)
     sn(j) = IIf(InStr(sn(j), "according to claim "), vbTab, "") & sn(j)
  Next
  
  Sheet1.TextBox2.Text = Join(sn, vbLf & vbLf)
End Sub

[Paul_Hossler]

p45cal, snb, paul: can't thank you enough. these are splendid solutions. But i have to commend p45cal because it was only his solution that included "indentations" or tabs. If the claim has the word "according to claim" then it should add a tab to that particular claim.

That's Ok, but I think that my macro also included tabbing.

Only thing I added was a tab to the first one since your 'claim 1' didn't address it one way or another