PDA

View Full Version : Make code more variable



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

snb
02-12-2020, 04:59 AM
Claims in Textboxes ?

Please post a sample workbook.

swaggerbox
02-12-2020, 05:11 AM
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
02-12-2020, 08:57 AM
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
02-12-2020, 09:09 AM
Private Sub CommandButton1_Click()
Sheet1.TextBox2.Text = Join(Filter(Split(Sheet1.TextBox1.Text, vbLf), "[", 0), vbLf & vbLf)
End Sub

Paul_Hossler
02-12-2020, 10:06 AM
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
02-13-2020, 03:30 AM
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
02-13-2020, 04:31 AM
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
02-13-2020, 09:08 AM
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