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

Shade all formula cells
To shade all formula cells: Home, Find & Select, Formulas to select all formulas. Then apply a light fill color.
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
 
Upvote 0
Wow!
This has been doing my head in for a long time
Thank-you Fluff, thank-you, thank-you, thank-you.:)
 
Upvote 0
You're welcome & thanks for the feedback
 
Upvote 0
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?
 
Upvote 0
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
 
Upvote 0
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 :)

 
Upvote 0
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!
 
Upvote 0
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
 
Upvote 0
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>
 
Upvote 0

Forum statistics

Threads
1,213,538
Messages
6,114,220
Members
448,554
Latest member
Gleisner2

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
Back
Top