Increment number in parenthesis by 1

[FryGirl]

So far I've been able to put together the following VBA code for replacing a number within the parentheses by 1.

However, if the cell does not contain parentheses, how do I avoid that error. Also, is there a cleaner way to do this.

In the example below, row 3 would change to 11 and row 5, 45, while keeping the parentheses.

Sub Test()
    Dim mystr As String
    Dim par1CharNum As Long
    Dim par2CharNum As Long
    Dim MyParseStr As Long
    Dim LastRow As Long: LastRow = Sheets("Birthdays").Cells(Rows.Count, "E").End(xlUp).Row
    Dim i As Long
    For i = 3 To LastRow
        mystr = Sheets("Birthdays").Range("E" & i).Value
        par1CharNum = InStr(1, mystr, "(")
        par2CharNum = InStr(par1CharNum, mystr, ")")
        MyParseStr = Mid(mystr, par1CharNum + 1, par2CharNum - par1CharNum - 1)
        Sheets("Birthdays").Range("E" & i).Value = Left(mystr, par1CharNum - 2) & " (" & MyParseStr + 1 & ")"
    Next i
End Sub

Calendar.xlsm
	E
1	Name
2	Mickey Mouse
3	Donald Duck (10)
4	George Washington
5	Abraham Lincoln (44)
Sheet2

 

[Snakehips]

@FryGirl This is perhaps an option.

Sub Test()
    Dim mystr As String
    Dim par1CharNum As Long
    Dim par2CharNum As Long
    Dim MyParseStr As Long
    Dim LastRow As Long: LastRow = Sheets("Birthdays").Cells(Rows.Count, "E").End(xlUp).Row
    Dim i As Long
    For i = 2 To LastRow
    On Error GoTo NXT
        mystr = Sheets("Birthdays").Range("E" & i).Value
        par1CharNum = InStr(1, mystr, "(")
        par2CharNum = InStr(par1CharNum, mystr, ")")
        MyParseStr = Mid(mystr, par1CharNum + 1, par2CharNum - par1CharNum - 1)
        Sheets("Birthdays").Range("E" & i).Value = Left(mystr, par1CharNum - 2) & " (" & MyParseStr + 1 & ")"
NXT:
Resume Next
   Next i
   On Error GoTo 0
End Sub

 

[DanteAmor]

Try:

Sub IncrementNumber()
  Dim c As Range
  For Each c In Sheets("Birthdays").Range("E2", Sheets("Birthdays").Range("E" & Rows.Count).End(3))
    If InStr(1, c.Value, "(") > 0 And InStr(1, c.Value, ")") > 0 Then
      c.Value = Split(c.Value, "(")(0) & "(" & Split(Split(c.Value, "(")(1), ")")(0) + 1 & ")"
    End If
  Next
End Sub

 

[FryGirl]

Thanks to you both. These work great, but I see where I failed to post all the correct information.

Sometimes there could be more than one birthday in a cell which displays as wrapped text. So, in this example, I need to increment row 6 Sammy Sosa to 35, but also keep George Brett in the same cell.

Calendar.xlsm
	E
1	Name
2	Mickey Mouse
3	Donald Duck (10)
4	George Washington
5	Abraham Lincoln (44)
6	George Brett Sammy Sosa (34)
Sheet3

 

[dmt32]

So, in this example, I need to increment row 6 Sammy Sosa to 35, but also keep George Brett in the same cell.

Hi,
see if this update to your code will do what you want

Sub Test()
    Dim rng         As Range, cell As Range
    Dim myvalue     As Long, i As Long
    
    With Worksheets("Birthdays")
        Set rng = .Range(.Range("E2"), .Range("E" & .Rows.Count).End(xlUp))
    End With
    
    For Each cell In rng.Cells
        For i = 1 To Len(cell.Value)
            If IsNumeric(Mid(cell.Value, i, 1)) Then
                myvalue = Val(Mid(cell.Value, i))
                cell.Value = Replace(cell.Value, myvalue, myvalue + 1)
            Exit For
            End If
        Next i
    Next cell

End Sub

Dave

 

[FryGirl]

Hi Dave, that surely did it based on the requirements I laid out, but of course I botched the example again. If there are two birthdays in the same cell it's only catching the first one. In this example, column C is the original, and then column E with the updates. Notice in row 7, the fourth name in the cell did not update. Also, row 8, the first name updates, but not the second.

Calendar.xlsm
	C	D	E
1	Name		Name
2	Mickey Mouse		Mickey Mouse
3	Donald Duck (10)		Donald Duck (11)
4	George Washington		George Washington
5	Abraham Lincoln (44)		Abraham Lincoln (45)
6	George Brett Sammy Sosa (34)		George Brett Sammy Sosa (35)
7	Cal Ripkin Mickey Mantle (33) Babe Ruth Lionel Messi (22)		Cal Ripkin Mickey Mantle (34) Babe Ruth Lionel Messi (22)
8	Alfred Hitchcock (55) Clint Eastwood (18)		Alfred Hitchcock (56) Clint Eastwood (18)
Sheet4

 

[dmt32]

Hi Dave, that surely did it based on the requirements I laid out, but of course I botched the example again.

Really helpful to share correct information with forum from outset

not fully tested but see if this modification to solution will do what you want

Sub Test()
    Dim rng         As Range, cell As Range
    Dim myvalue     As Long, i As Long
    
    With Worksheets("Birthdays")
        Set rng = .Range(.Range("E2"), .Range("E" & .Rows.Count).End(xlUp))
    End With
    
    For Each cell In rng.Cells
        For i = 1 To Len(cell.Value)
            If IsNumeric(Mid(cell.Value, i, 1)) Then
                myvalue = Val(Mid(cell.Value, i))
                cell.Value = Replace(cell.Value, myvalue, myvalue + 1)
                i = i + Len(myvalue)
            End If
        Next i
    Next cell

End Sub

Dave

 

[DanteAmor]

You should put all the scenarios from the beginning!

Try:

Sub IncrementNumber()
  Dim c As Range
  Dim xd As Variant
  Dim cad As String
  
  For Each c In Sheets("Birthdays").Range("E2", Sheets("Birthdays").Range("E" & Rows.Count).End(3))
    If InStr(1, c.Value, "(") > 0 And InStr(1, c.Value, ")") > 0 Then
      cad = ""
      For Each xd In Split(c.Value, "(")
        If InStr(1, xd, ")") > 0 Then
          cad = cad & "(" & Split(xd, ")")(0) + 1 & ")" & Split(xd, ")")(1)
        Else
          cad = cad & xd
        End If
      Next
      c.Value = cad
    End If
  Next
End Sub

 

[FryGirl]

Hi Dave and sorry for the missed information. This seems to work perfectly for my needs. Thank a bunch.

 

[DanteAmor]

not fully tested but see if this modification to solution will do what you want

If there are 2 equal ages in the cell, the increment is 2 instead of 1.