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>
 

Some videos you may like

Excel Facts

Did you know Excel offers Filter by Selection?
Add the AutoFilter icon to the Quick Access Toolbar. Select a cell containing Apple, click AutoFilter, and you will get all rows with Apple

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
52,898
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
52,898
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
52,898
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
52,898
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
52,898
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>
 

Watch MrExcel Video

Forum statistics

Threads
1,122,469
Messages
5,596,316
Members
414,053
Latest member
Dual Showman

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