swaggerbox
02-12-2020, 03:58 AM
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
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