Risky macros - how to streamline and improve

Adendum

New Member
Joined
Feb 15, 2021
Messages
24
Office Version
  1. 2016
Platform
  1. Windows
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?


VBA Code:
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
 

Excel Facts

Copy formula down without changing references
If you have =SUM(F2:F49) in F50; type Alt+' in F51 to copy =SUM(F2:F49) to F51, leaving the formula in edit mode. Change SUM to COUNT.

Yongle

Well-known Member
Joined
Mar 11, 2015
Messages
6,977
Office Version
  1. 365
Platform
  1. Windows
Is there always a space immediately before "Added dd mmm yyyy" in column A?
 

Yongle

Well-known Member
Joined
Mar 11, 2015
Messages
6,977
Office Version
  1. 365
Platform
  1. Windows
Try this
VBA Code:
    For Each cell In Range("A2:A2000").Cells
        cell.Offset(0, 1).Value = CDate(Trim(Replace(Right(cell.Value, 17), "Added ", "")))
    Next cell
 

Yongle

Well-known Member
Joined
Mar 11, 2015
Messages
6,977
Office Version
  1. 365
Platform
  1. Windows

ADVERTISEMENT

Did you try the code provided above?
 

Adendum

New Member
Joined
Feb 15, 2021
Messages
24
Office Version
  1. 2016
Platform
  1. Windows
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

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
64,110
Office Version
  1. 365
Platform
  1. Windows

ADVERTISEMENT

How about
VBA Code:
   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

New Member
Joined
Feb 15, 2021
Messages
24
Office Version
  1. 2016
Platform
  1. Windows
How about
VBA Code:
   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

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
64,110
Office Version
  1. 365
Platform
  1. Windows
How about
VBA Code:
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

New Member
Joined
Feb 15, 2021
Messages
24
Office Version
  1. 2016
Platform
  1. Windows
How about
VBA Code:
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...


VBA Code:
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
 

Forum statistics

Threads
1,144,622
Messages
5,725,338
Members
422,618
Latest member
Shull1

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