Vba add 1 to number inside text for column

[Fred_111]

[TABLE="width: 286"]
<tbody>[TR]
[TD="colspan: 2"]Hello there,[/TD]
[/TR]
[TR]
[TD="colspan: 2"]I have a worksheet where I'd like to add 1 year to the Date column and add 1 to a number inside some text in another column.
The Date column, I have sorted, but the number inside text is the worry.
My Col "K" has entries like '12/09/2019' & '17/10/2019'.
Col "L" has 'Birthday, 74 yrs' & 'Wedding Anniversary, 58 yrs'
I can Evaluate the formula into 'new' cells, but how can I update into the existing cells?
My code so far is..

Sub Test_VBA_2()
Dim LastRow As Long
Dim i As Long
With ActiveSheet
    LastRow = Range("J" & Rows.Count).End(xlUp).Row
    For i = 4 To LastRow
    
        If Range("K" & i) <> "" Then
        .Range("K" & i).Value = DateAdd("yyyy", 1, .Range("K" & i).Value)
'''     I'm trying to do a similar thing for Col "L", add 1 to the number inside text.
'''     The formula would be like '=IF(L4<>"",LEFT(L4,(FIND(",",L4)+1))&LEFT(MID(L4,FIND(",",L4)+2,256),2)+1&RIGHT(L4,4),"")
'''     I converted the formula to
'''     .Range("L" & i).Formula = "=IF(.Range(" & Chr(34) & "L" & Chr(34) & " & i)<>" & Chr(34) & Chr(34) & ",LEFT(.Range(" & Chr(34) & "L" & Chr(34) & " & i),(FIND(" & Chr(34) & "," & Chr(34) & ",.Range(" & Chr(34) & "L" & Chr(34) & " & i))+1))&LEFT(MID(.Range(" & Chr(34) & "L" & Chr(34) & " & i),FIND(" & Chr(34) & "," & Chr(34) & ",.Range(" & Chr(34) & "L" & Chr(34) & " & i))+2,256),2)+1&RIGHT(.Range(" & Chr(34) & "L" & Chr(34) & " & i),4)," & Chr(34) & Chr(34) & ")"
'''     Calculate
'''     .value = .value
'''     But it produces a Run-time error '1004'   Application-defined or Object-defined error
        End If
    Next i
End With
'With [M4:M5]    This gives the correct answer but in NEW cells
'  [M4].Value = "=IF(L4<>" & Chr(34) & Chr(34) & ",LEFT(L4,(FIND(" & Chr(34) & "," & Chr(34) & ",L4)+1))&LEFT(MID(L4,FIND(" & Chr(34) & "," & Chr(34) & ",L4)+2,256),2)+1&RIGHT(L4,4)," & Chr(34) & Chr(34) & ")"
'  [M5].Value = "=IF(L5<>" & Chr(34) & Chr(34) & ",LEFT(L5,(FIND(" & Chr(34) & "," & Chr(34) & ",L5)+1))&LEFT(MID(L5,FIND(" & Chr(34) & "," & Chr(34) & ",L5)+2,256),2)+1&RIGHT(L5,4)," & Chr(34) & Chr(34) & ")"
'    Calculate
'    .Value = .Value
'End With

End Sub

Any help would be appreciated.
[/TD]
[/TR]
[TR]
[TD="colspan: 2"][/TD]
[/TR]
[TR]
[TD]

<tbody>
</tbody>

<tbody>
</tbody>

[/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD="colspan: 2"][/TD]
[/TR]
</tbody>[/TABLE]

 

[Fluff]

Hi & welcome to MrExcel.
How about

With Range("L4:L" & LastRow)
   .Value = Evaluate(Replace("IF(@<>"""",LEFT(@,(FIND("","",@)+1))&LEFT(MID(@,FIND("","",@)+2,256),2)+1&RIGHT(@,4),"""")", "@", .Address))
End With

 

[Fred_111]

Wow!
This has been doing my head in for a long time
Thank-you Fluff, thank-you, thank-you, thank-you.

 

[Fluff]

You're welcome & thanks for the feedback

 

[Fred_111]

Just to make it a bit more difficult, I'm now wondering how I can limit my updates to rows where Col "B" Date <= Today()
Code so far is..

With ActiveSheet
LastRow = Range("A" & Rows.Count).End(xlUp).Row
    With Range("F2:F" & LastRow)    'Description Col
    .Value = Evaluate(Replace("IFERROR(LEFT(@,(FIND("", "",@)+1))&LEFT(MID(@,FIND("", "",@)+2,256),2)+1&RIGHT(@,4),@)", "@", .Address))
        With Range("B2:B" & LastRow)    'Date Col
        .Value = Evaluate(Replace("if(@ < Today(),DATE(YEAR(@)+1,MONTH(@),DAY(@)),@)", "@", .Address))
            With Range("D2:D" & LastRow)    'Date Col
            .Value = Evaluate(Replace("if(@ < Today(),DATE(YEAR(@)+1,MONTH(@),DAY(@)),@)", "@", .Address))
            End With
        End With
    End With
End With

Any ideas?​

 

[Fluff]

Try

With ActiveSheet
   LastRow = .Range("A" & Rows.Count).End(xlUp).Row
   With .Range("F2:F" & LastRow)    'Description Col
      .Value = Evaluate(Replace("IFERROR(LEFT(@,(FIND("", "",@)+1))&LEFT(MID(@,FIND("", "",@)+2,256),2)+1&RIGHT(@,4),@)", "@", .Address))
   End With
   With .Range("B2:B" & LastRow)    'Date Col
      .Value = Evaluate(Replace("if(@ < Today(),DATE(YEAR(@)+1,MONTH(@),DAY(@)),@)", "@", .Address))
   End With
   With .Range("D2:D" & LastRow)    'Date Col
      .Value = Evaluate(Replace("if(@ < Today(),DATE(YEAR(@)+1,MONTH(@),DAY(@)),@)", "@", .Address))
   End With
End With

 

[Fred_111]

Nah Fluff, in this code, it doesn't matter where the 'End With' is. The code for the Date columns works fine, it's the Description column that's the worry.

I may have to change my approach. Maybe I need code that looks at one row at a time.
Look at the date in row 2 col B, if it's < = Today(), add 1 year,
then look at row 2 col D,

if it's < = Today(), add 1 year AND add 1 to the number inside the text in row 2 col F
Then on to row 3...etc
When it finds a date > Today, exit.

Thanks for your help though

​

​

 

[Fluff]

If the code is written correctly, it does matter where the With/End With goes.
Also there was no mention of adding 1 to col F based on other values, which is why it doesn't do that!

 

[Fluff]

Maybe

With ActiveSheet
   lastrow = .Range("A" & Rows.Count).End(xlUp).Row
   With .Range("F2:F" & lastrow)    'Description Col
      .Value = Evaluate(Replace("if(" & .Offset(, -2).Address & "<today(),IFERROR(LEFT(@,(FIND("", "",@)+1))&LEFT(MID(@,FIND("", "",@)+2,256),2)+1&RIGHT(@,4),@),@)", "@", .Address))
   End With
   With .Range("B2:B" & lastrow)    'Date Col
      .Value = Evaluate(Replace("if(@ < Today(),DATE(YEAR(@)+1,MONTH(@),DAY(@)),@)", "@", .Address))
   End With
   With .Range("D2:D" & lastrow)    'Date Col
      .Value = Evaluate(Replace("if(@ < Today(),DATE(YEAR(@)+1,MONTH(@),DAY(@)),@)", "@", .Address))
   End With
End With

 

[Fred_111]

I have some chores to do now, but I'm thinking along the lines of...

Dim I As Integer
i = 2
Do While Cells(i, 2).Value <= Today()
Cells(i, 6).Value = [Desc code here]
Cells(i, 4).Value = [Date code here]
Cells(i, 2).Value = [Date code here]
i = i + 1
Loop
​

​

[TABLE="width: 152"]
<colgroup><col></colgroup><tbody>[TR]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[/TR]
</tbody>[/TABLE]