Need VBA code to search for a consistently formatted date string within the cells in a row and ALT+Enter infront of the date

KlayontKress

Board Regular
Joined
Jan 20, 2016
Messages
67
Office Version
  1. 2016
Platform
  1. Windows
To all,


As the title says, I'm looking for a VBA script that will always look in all of the cells in Row 8 for a date string formatted like "2019-10-09" and do an "Alt+Enter" in front of the date to move it down to its own line. We currently have employees doing this manually 1 cell at a time on our quotes and this takes forever. a VBA script could save between 5 and 20 minutes on a particular quote to our customers which really adds up throughout the day in lost productivity, would allow for the employee to slow down and better check their work on a more critical part of their job, and removes a tedious annoyance.

We have a program that dumps data to excel, and the room names for what we designed and priced for our clients are in individual columns. Our program allows us to put a date at the end, but we can't put a return in front of it prior to coming to excel. The customers want this date on its own line so that it's easier for them to see when the room was last modified, but they don't want us to increase the cell width to achieve this. A sample room name would be "STANDARD KITCHEN- ISLAND- 2019-10-09". We occationally run into instances where the designer/quoter will forget to leave a space between the room name and the date, so the date won't always go to its own line even if there was space because it's tied to a previous string.
The easiest solution is a macro to do what we are doing by hand, but I don't know how to find a date string within a cell and always return before the first number in that string.


Any help anyone can provide would be greatly appreciated.

Thanks,
 

Some videos you may like

Excel Facts

What is the shortcut key for Format Selection?
Ctrl+1 (the number one) will open the Format dialog for whatever is selected.

pjmorris

Well-known Member
Joined
Aug 2, 2012
Messages
1,989
Office Version
  1. 2016
Platform
  1. Windows
Assuming that all you need to do is run the macro on the active cell try this. Go to the relevant cell and run the macro, it will identify the first number in the string and put a Chr$(10) in front of it. It doesn't check that that number is actually the year part of a date, though it probably could be made to do so:

VBA Code:
Sub addCR_LF()
    Dim nDate As Integer
    Dim nMonth As Integer
    Dim nDay As Integer
    Dim strTestString As String
    Dim Strings() As String
    
    Dim n As Integer 'general counter
    Dim m As Integer 'general counter
    
    strTestString = ""
    
    Strings = Split(ActiveCell, "-")
    
    For n = 0 To UBound(Strings)
        If IsNumeric(Trim(Strings(n))) Then Exit For
    Next n
    
    For m = 0 To UBound(Strings)
        If m = n Then strTestString = strTestString & Chr$(10)
        If m <> 0 Then strTestString = strTestString & "-"
        strTestString = strTestString & Strings(m)
    Next m
    ActiveCell = strTestString
End Sub
 

pjmorris

Well-known Member
Joined
Aug 2, 2012
Messages
1,989
Office Version
  1. 2016
Platform
  1. Windows
Actually, couldn't resist adding in checking of the date:

VBA Code:
Sub addCR_LF()
    Dim nDate As Integer
    Dim nMonth As Integer
    Dim nDay As Integer
    Dim strTestString As String
    Dim Strings() As String
    
    Dim n As Integer 'general counter
    Dim m As Integer 'general counter
    
    strTestString = ""
    
    Strings = Split(ActiveCell, "-")
    
    On Error GoTo leave
    
    For n = 0 To UBound(Strings)
        If IsNumeric(Trim(Strings(n))) Then
            If IsDate(Trim(Strings(n)) & "-" & Trim(Strings(n + 1)) & "-" & Trim(Strings(n + 2))) Then
                Exit For
            Else
                Exit Sub
            End If
        End If
    Next n
    
    For m = 0 To UBound(Strings)
        If m = n Then strTestString = strTestString & Chr$(10)
        If m <> 0 Then strTestString = strTestString & "-"
        strTestString = strTestString & Strings(m)
    Next m
    ActiveCell = strTestString

leave:
    On Error GoTo 0

End Sub

hope it helps.
 

JoeMo

MrExcel MVP
Joined
May 26, 2009
Messages
17,414
Office Version
  1. 365
  2. 2010
Platform
  1. Windows
We have a program that dumps data to excel, and the room names for what we designed and priced for our clients are in individual columns. Our program allows us to put a date at the end, but we can't put a return in front of it prior to coming to excel. The customers want this date on its own line so that it's easier for them to see when the room was last modified, but they don't want us to increase the cell width to achieve this. A sample room name would be "STANDARD KITCHEN- ISLAND- 2019-10-09". We occationally run into instances where the designer/quoter will forget to leave a space between the room name and the date, so the date won't always go to its own line even if there was space because it's tied to a previous string.
The easiest solution is a macro to do what we are doing by hand, but I don't know how to find a date string within a cell and always return before the first number in that string.


Any help anyone can provide would be greatly appreciated.

Thanks,
Assuming "own line" means the date remains in the cell and is separated by alt +enter and that the data always has the format in your example, this should handle the case where the space between room name and date has been forgotten.
VBA Code:
Sub KlayontKress()
'select the cells you want to modify first, then run this macro
Dim c As Range, x As Variant, i As Long
Application.ScreenUpdating = False
For Each c In Selection
    For i = 1 To Len(c.Value)
        If (Mid(c.Value, i, 2) Like "[A-Z]" & "-" And Mid(c.Value, i + 2, 1) Like "[0-9]") Then
            c.Value = Mid(c.Value, 1, i - 1) & Replace(c.Value, "-", "- ", i, 1)
            Exit For
        End If
    Next i
    x = Split(c, " ")
    For i = LBound(x) To UBound(x)
        If IsDate(x(i)) Then
            x(i) = Chr(10) & x(i) & Chr(10)  'Remove the "& Chr(10) if date is always at the end of the string
        End If
    Next i
    With c
        .Value = Join(x, " ")
        .WrapText = True
        .EntireColumn.AutoFit
    End With
Next c
Application.ScreenUpdating = True
End Sub
 

KlayontKress

Board Regular
Joined
Jan 20, 2016
Messages
67
Office Version
  1. 2016
Platform
  1. Windows

ADVERTISEMENT

Actually, couldn't resist adding in checking of the date:

VBA Code:
Sub addCR_LF()
    Dim nDate As Integer
    Dim nMonth As Integer
    Dim nDay As Integer
    Dim strTestString As String
    Dim Strings() As String
   
    Dim n As Integer 'general counter
    Dim m As Integer 'general counter
   
    strTestString = ""
   
    Strings = Split(ActiveCell, "-")
   
    On Error GoTo leave
   
    For n = 0 To UBound(Strings)
        If IsNumeric(Trim(Strings(n))) Then
            If IsDate(Trim(Strings(n)) & "-" & Trim(Strings(n + 1)) & "-" & Trim(Strings(n + 2))) Then
                Exit For
            Else
                Exit Sub
            End If
        End If
    Next n
   
    For m = 0 To UBound(Strings)
        If m = n Then strTestString = strTestString & Chr$(10)
        If m <> 0 Then strTestString = strTestString & "-"
        strTestString = strTestString & Strings(m)
    Next m
    ActiveCell = strTestString

leave:
    On Error GoTo 0

End Sub

hope it helps.


much appreciated for the help. Is there a way to modify this to do it for every cell in a row that has data in it? I need to apply this to all of row 8.
 

pjmorris

Well-known Member
Joined
Aug 2, 2012
Messages
1,989
Office Version
  1. 2016
Platform
  1. Windows
Try this, simply select the cells you want to check/change and then run the macro.

VBA Code:
Sub addCR_LF()

    Dim cTest As Range
    Dim strTestString As String
    Dim Strings() As String
   
    Dim n As Integer 'general counter
    Dim m As Integer 'general counter
   
    
    For Each cTest In Selection
         strTestString = ""
        
         Strings = Split(cTest, "-")
        
         On Error GoTo leave
        
         For n = 0 To UBound(Strings)
             If IsNumeric(Trim(Strings(n))) Then
                 If IsDate(Trim(Strings(n)) & "-" & Trim(Strings(n + 1)) & "-" & Trim(Strings(n + 2))) Then
                     Exit For
                 Else
                     Exit Sub
                 End If
             End If
         Next n
        
         For m = 0 To UBound(Strings)
             If m = n Then strTestString = strTestString & Chr$(10)
             If m <> 0 Then strTestString = strTestString & "-"
             strTestString = strTestString & Strings(m)
         Next m
         cTest = strTestString
    Next cTest

leave:
    On Error GoTo 0

End Sub
 

KlayontKress

Board Regular
Joined
Jan 20, 2016
Messages
67
Office Version
  1. 2016
Platform
  1. Windows
Try this, simply select the cells you want to check/change and then run the macro.

VBA Code:
Sub addCR_LF()

    Dim cTest As Range
    Dim strTestString As String
    Dim Strings() As String
  
    Dim n As Integer 'general counter
    Dim m As Integer 'general counter
  
   
    For Each cTest In Selection
         strTestString = ""
       
         Strings = Split(cTest, "-")
       
         On Error GoTo leave
       
         For n = 0 To UBound(Strings)
             If IsNumeric(Trim(Strings(n))) Then
                 If IsDate(Trim(Strings(n)) & "-" & Trim(Strings(n + 1)) & "-" & Trim(Strings(n + 2))) Then
                     Exit For
                 Else
                     Exit Sub
                 End If
             End If
         Next n
       
         For m = 0 To UBound(Strings)
             If m = n Then strTestString = strTestString & Chr$(10)
             If m <> 0 Then strTestString = strTestString & "-"
             strTestString = strTestString & Strings(m)
         Next m
         cTest = strTestString
    Next cTest

leave:
    On Error GoTo 0

End Sub
Worked great. Thank you for the help
 

pjmorris

Well-known Member
Joined
Aug 2, 2012
Messages
1,989
Office Version
  1. 2016
Platform
  1. Windows
delighted it worked and many thanks for the feedback.
 

Watch MrExcel Video

Forum statistics

Threads
1,127,898
Messages
5,627,526
Members
416,250
Latest member
darius_rebelo

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