VBA clean up conditional duplication of rows - string

Question

I have a data set in which there is an id field and a number of other fields.
The id field at times has a second id. In this case, I need to create a new duplicated record and put a single id in each of the records. There is an additional condition in which each of the ids may be followed by a number which is a percentage. In all cases, I need to display the correct percentage as a decimal value in a field on the record.
id examples:
AJ01-25/ST01-75
AJ01/LM03
RICH01
Correct representation of ids and percentages:
id percent
AJ01 .25
ST01 .75
AJ01 .5
LM03 .5
RICH01 1.0
I used the following code to create a new record and parse any percentages into a new field whenever a "/" is detected, but I'd very much like to have something cleaner. Sort order does not matter (my script places new records at the end). Thoughts?
Sub breakemup()
Dim wb As Workbook
Dim ws As Worksheet
Dim id As String
Dim rng As Range
Dim ar() As String
Set wb = ThisWorkbook
Set ws = wb.Worksheets("data")
Dim currentRow As Integer
Dim finalRow As Integer
finalRow = ws.UsedRange.Rows.Count
For currentRow = 2 To finalRow
ar() = Split(ws.Range("a" & currentRow).Value, "/")
If UBound(ar) = 1 Then
ws.Rows(currentRow).Copy Destination:=ws.Range("A" & Rows.Count).End(xlUp).Offset(1)
If UBound(Split(ar(1), "-")) = 1 Then
ws.Range("A" & Rows.Count).End(xlUp).Value = Split(ar(1), "-")(0)
ws.Range("A" & Rows.Count).End(xlUp).Offset(0, 1).Value = CDbl(Split(ar(1), "-")(1)) / 100#
ws.Range("A" & currentRow).Value = Split(ar(0), "-")(0)
ws.Range("A" & currentRow).Offset(0, 1).Value = CDbl(Split(ar(0), "-")(1)) / 100#
Else
ws.Range("A" & Rows.Count).End(xlUp).Value = ar(1)
ws.Range("A" & Rows.Count).End(xlUp).Offset(0, 1).Value = 50 / 100#
ws.Range("A" & currentRow).Value = ar(0)
ws.Range("A" & currentRow).Offset(0, 1).Value = 50 / 100#
End If
Else
ws.Range("A" & currentRow).Offset(0, 1).Value = 1#
End If
Next
End Sub

Answer 1

Not sure if you would consider this cleaner but here is a formula solution rather than a VBA one. It uses the functions:
INDIRECT
MID
LEN
IF
RIGHT
FIND
Lets say we have the following in sheet 1:
Insert the following formulas in sheet 2:
Cell A2:
=IF(E2=1, IF(D2="", IF(C2="", INDIRECT(G2), LEFT(INDIRECT(G2), C2-1)), LEFT(INDIRECT(G2), D2-1)), IF(D2="",IF(C1="", INDIRECT(G2), RIGHT(INDIRECT(G2), LEN(INDIRECT(G2))-C1)), MID(INDIRECT(G2), C1+1, D2 -1-C1)))
Drag / Copy it down to cover the rest of the cells in column A
Cell B2:
=IF(E2=1,IF(C2="",IF(D2="",1,MID(INDIRECT(G2),C2+1,LEN(INDIRECT(G2)))),IF(D2="",0.5,MID(INDIRECT(G2),D2+1,C2-D2-1)/100)), IF(D2="",0.5,MID(INDIRECT(G2),D2+1, LEN(INDIRECT(G2))-D2)/100))
Drag / Copy it down to cover the rest of the cells in column B
Cell C2:
=IF(E2=1, IF(ISNUMBER(FIND("/",INDIRECT(G2))),FIND("/", INDIRECT(G2)), ""), "")
Drag / Copy it down to cover the rest of the cells in column C
Cell D2:
=IF(E2=1, IF(ISNUMBER(FIND("-", INDIRECT(G2))),FIND("-", INDIRECT(G2)), ""),IF(D1 ="", "", FIND("-", INDIRECT(G2), D1+1)))
Drag / Copy it down to cover the rest of the cells in column D
Cell E2:
The number value "1"
Cell E3:
=IF(E2=1, IF(C2="", 1, 2),1)
Drag / Copy it down to cover the rest of the cells in column E
Cell F2:
the number value "1"
Cell F3:
=IF(E3=1, F2+1, F2)
Drag / Copy it down to cover the rest of the cells in column F
Cell G2:
="Sheet1!A" & TEXT(F2, 0)
Drag / Copy it down to cover the rest of the cells in column G
Result:
You could hide the extra columns so you only see the columns you need:
I have an article on my blog that provides an example with pretty much the same functions used here, it might help with understanding the functions used Excel Functions and Formulas Sample #1, Split Strings Based on Delimeter