Vba add 1 to number inside text for column

Fred_111

New Member
Joined
Mar 27, 2019
Messages
7
Hello there,
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..
Code:
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.

<tbody>
</tbody>

<tbody>
</tbody>

<tbody>
</tbody>
 

Excel Facts

What did Pito Salas invent?
Pito Salas, working for Lotus, popularized what would become to be pivot tables. It was released as Lotus Improv in 1989.

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
73,224
Office Version
  1. 365
Platform
  1. Windows
Hi & welcome to MrExcel.
How about
Code:
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

New Member
Joined
Mar 27, 2019
Messages
7
Wow!
This has been doing my head in for a long time
Thank-you Fluff, thank-you, thank-you, thank-you.:)
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
73,224
Office Version
  1. 365
Platform
  1. Windows
You're welcome & thanks for the feedback
 

Fred_111

New Member
Joined
Mar 27, 2019
Messages
7

ADVERTISEMENT

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..

Rich (BB code):
Rich (BB code):
Rich (BB code):
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

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
73,224
Office Version
  1. 365
Platform
  1. Windows
Try
Code:
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

New Member
Joined
Mar 27, 2019
Messages
7

ADVERTISEMENT

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

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
73,224
Office Version
  1. 365
Platform
  1. Windows
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

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
73,224
Office Version
  1. 365
Platform
  1. Windows
Maybe
Code:
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

New Member
Joined
Mar 27, 2019
Messages
7
I have some chores to do now, but I'm thinking along the lines of...

Rich (BB code):
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

<colgroup><col></colgroup><tbody>
</tbody>
 
Master Excel Bundle

Excel contains over 450 functions, with more added every year. That’s a huge number, so where should you start? Right here with this bundle.

Forum statistics

Threads
1,164,095
Messages
5,835,363
Members
430,352
Latest member
xvidzoro

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top