Risky macros - how to streamline and improve

[Adendum]

Hi Gurus,
I have 3 individual macros that I have been using but realise that sometimes these can be problematic.

What I need to do is after importing 200-300 rows of data is to move the last part of the text (Added dd mmm yyyy) from column A into column B. Ideally I would like to have the data in column B to be actual dates so instead of "Added 17 Jan 2021" it becomes 17/01/2021 (so I can later sort on column B). The problem I have found is that the imported data isn't always 17 characters - so "Added 5 Jan 2021" is only 16 whereas "Added 21 Jan 2021" is 17. So I am stumped!

For my education I would prefer to see examples that break down the processes. Any ideas?

Sub B_CopyAdded()
  For Each cell In Range("A2:A2000").Cells
    cell.Offset(0, 1).Value = Right(cell.Value, 17)
  Next cell
  Columns("A:A").Select
     
End Sub
Sub C_RemoveAdded()
' Deletes last 17 characters
' Defines variables
On Error Resume Next
    For Each cel In Range("A2:A2000")
        myVal = cel.Value
        cel.Value = Left(myVal, Len(myVal) - 17)
    Next cel
End Sub
Sub D_TrimCells()
Dim Cl As Range
   For Each Cl In Range("B2:B2000", Range("A" & Rows.Count).End(xlUp))
      Cl.Value = Trim(Cl.Value)
   Next Cl
End Sub

 

[Fluff]

How about

Sub Adendum()
   Dim Cl As Range
   For Each Cl In Range("A2", Range("A" & Rows.Count).End(xlUp))
      On Error Resume Next
      Cl.Offset(0, 1).Value = CDate(Trim(Right(Cl.Value, 11)))
      On Error GoTo 0
   Next Cl
   With Range("A2", Range("A" & Rows.Count).End(xlUp))
      .Value = Evaluate(Replace("if({1},trim(left(@,search(""added"",@&""added"")-1)))", "@", .Address))
   End With
End Sub

 

[Adendum]

Arghhh, my incoming data has changed shape and my macro no longer works. So far my manual adjustments just break what was working - hopefully my fav gurus can point out the error of my ways.

My data used to arrive in this format and the vba below worked perfectly.

Fred Flintstone Added 9 Mar 2021
Barney Rubble Added 9 Mar 2021
Wilma Flintstone Added 9 Mar 2021
Betty Rubble Added 9 Mar 2021

Sub Added_Text_manipulation()
Dim Cl As Range
   For Each cell In Range("A2", Range("A" & Rows.Count).End(xlUp))
      On Error Resume Next
      cell.Offset(0, 1).Value = CDate(Trim(Right(cell.Value, 11)))
      On Error GoTo 0
   Next cell

 Dim r As Long, HSindex As Long
        lstR = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
    For r = 1 To lstR
        With ThisWorkbook.ActiveSheet
        HSindex = InStr(.Range("A" & r).Value, "Added")
    If HSindex > 1 Then
    .Range("A" & r).Value = Left(.Range("A" & r).Value, HSindex - 1)
End If
End With
Next r
End Sub

But today my data arrives like this...

Fred Flintstone Added 9 Mar 2021 1 day overdue
Barney Rubble Added 9 Mar 2021 1 day overdue
Wilma Flintstone Added 9 Mar 2021 1 day overdue
Betty Rubble Added 9 Mar 2021 1 day overdue

Worse news ... I will also have to cater for data that arrives as

Fred Flintstone Added 7 Mar 2021 3 days overdue
Barney Rubble Added 1 Mar 2021 10 days overdue

And I don't need to retain the dd day/s overdue!

All I want is to end up with Fred Flintstone in Column A and the date in column B as it was before.

Appreciate your help guys and gals!

Paul

 

[Fluff]

How about

Sub Adendum()
   With Range("A2", Range("A" & Rows.Count).End(xlUp))
      .Offset(, 1).Value = Evaluate(Replace("if({1},trim(mid(@,search(""added"",@)+6,11)))", "@", .Address))
      .Value = Evaluate(Replace("if({1},trim(left(@,search(""added"",@&""added"")-1)))", "@", .Address))
   End With
End Sub

 

[Adendum]

How about

Sub Adendum()
   With Range("A2", Range("A" & Rows.Count).End(xlUp))
      .Offset(, 1).Value = Evaluate(Replace("if({1},trim(mid(@,search(""added"",@)+6,11)))", "@", .Address))
      .Value = Evaluate(Replace("if({1},trim(left(@,search(""added"",@&""added"")-1)))", "@", .Address))
   End With
End Sub

Fluff,
I have to say that the above not only works perfectly and also caters for longer dates it's such short code. As a temporary work around I just added some extra code to strip out the last 14 characters and added that to the last working version. It worked but would fall down when we got to double digits.

Can I ask you to somehow breakdown the code you have written so I can better understand ... at least the .Offset line and the .Value line as I can't work out how this is doing its magic!

And thanks!

Paul.

 

[Fluff]

The Evaluate takes an Xl formula as a string & calculates it, whilst the @ is a placeholder & is replaced by .Address, so that you get

=TRIM(MID(A2,SEARCH("added",A2)+6,11))

HTH

 

[Adendum]

The Evaluate takes an Xl formula as a string & calculates it, whilst the @ is a placeholder & is replaced by .Address, so that you get

=TRIM(MID(A2,SEARCH("added",A2)+6,11))

HTH

Fluff,

Thanks for that.

 

[Fluff]

You're welcome & thanks for the feedback.

 

[Adendum]

You're welcome & thanks for the feedback.

I have only just made a discovery...

Any date conversions we do from 10 to 31 all work perfectly and we end up with dates correctly formatted as dd-mmm-yyy but any dates from 1 to 9 create dates as text cells.

So the data that arrives as 14 Sep 2021 is correctly converted to 14-Sep-2021 but a date arriving as 4 Sep 2021 becomes "4 Sep 2021"

My incoming data has the following format
Barney Rubble Added 16 Mar 2021 22 days overdue
Betty Rubble Added 18 Mar 2021 20 days overdue
Wilma Flintstone Added 3 Apr 2021 4 days overdue
Fred Flintstone Added 6 Apr 2021 1 day overdue

So Barney and Betty would convert correctly but Wilma and Fred end up with text not dates.

Can you extend your magical powers Fluff?

 

[Fluff]

Those dates get converted quite happily for me, but does this help

Sub Adendum()
   With Range("A2", Range("A" & Rows.Count).End(xlUp))
      .Offset(, 1).Value = Evaluate(Replace("if({1},trim(mid(@,search(""added"",@)+6,11)+0))", "@", .Address))
      .Value = Evaluate(Replace("if({1},trim(left(@,search(""added"",@&""added"")-1)))", "@", .Address))
   End With
End Sub

 

[Adendum]

Those dates get converted quite happily for me, but does this help

Sub Adendum()
   With Range("A2", Range("A" & Rows.Count).End(xlUp))
      .Offset(, 1).Value = Evaluate(Replace("if({1},trim(mid(@,search(""added"",@)+6,11)+0))", "@", .Address))
      .Value = Evaluate(Replace("if({1},trim(left(@,search(""added"",@&""added"")-1)))", "@", .Address))
   End With
End Sub

Nope, that generates a column of #VALUE!