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

 

[Yongle]

Is there always a space immediately before "Added dd mmm yyyy" in column A?

 

[Yongle]

Try this

    For Each cell In Range("A2:A2000").Cells
        cell.Offset(0, 1).Value = CDate(Trim(Replace(Right(cell.Value, 17), "Added ", "")))
    Next cell

 

[Adendum]

Is there always a space immediately before "Added dd mmm yyyy" in column A?

Hi Yongle,

Yes there is always a space before the word "Added"

 

[Yongle]

Did you try the code provided above?

 

[Adendum]

Did you try the code provided above?

Yongle,

Many thanks yes, I just did and it is very close to perfection! I'm impressed....however,
Running the macro creates a perfect list of dates dd/mm/yyyy - just what I wanted, but the macro throws up the following message box:-

Runtime error '13'
Type Mismatch
and Debug highlights the following line of code

cell.Offset(0, 1).Value = CDate(Trim(Replace(Right(cell.Value, 17), "Added ", "")))

But the list is perfect in column B!! Not sure if the number of rows makes a difference but my test data was only 23 rows, the actual file could be anything from 30, to 200 to 1100 - very variable.

So if we can fix the error 13 what are the chances we can get super slick and remove the Added ... string from Column A at the end of the process?

Paul.

 

[Fluff]

How about

   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

 

[Adendum]

How about

   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

Hi Fluff,

Fluff? I wont ask

Thanks, this also work and without the error message after the process. So excellent progress. All I need now is to do this data conversion and delete the redundant "Added dd mmm yyyy" string from column A without damaging the remaining text. What would be the safest way to do that - and can this be combined into a single macro?

Paul.

 

[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("trim(left(@,search(""added"",@&""added"")-1))", "@", .Address))
   End With
End Sub

 

[Adendum]

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("trim(left(@,search(""added"",@&""added"")-1))", "@", .Address))
   End With
End Sub

Fluff,

Thanks for that. It almost worked but the results in column A were all populated with the same values - so A1 just repeated in all the other cells in column A. But seeing your code helped me understand the concept so I tried a "combination" and found this works...

Sub TEST()
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