News, tips, advice, support for Windows, Office, PCs & more. Tech help. No bull. We're community supported by donations from our Plus Members, and proud of it
Home icon Home icon Home icon Email icon RSS icon
  • VBA delete cell content with EXCEPTION(s)

    Posted on krweaver Comment on the AskWoody Lounge

    Home Forums AskWoody support Productivity software by function MS Excel and spreadsheet help VBA delete cell content with EXCEPTION(s)

    This topic contains 13 replies, has 6 voices, and was last updated by  woody 5 months, 3 weeks ago.

    • Author
      Posts
    • #1107113 Reply

      krweaver
      AskWoody Lounger

      I have a range of cells (say, E6:R100) and I want to removed everything from the cells with two exceptions: (1) dates remain and (2) char(10) remains.

      So, a cell might have char(10)&”4/29/2019″&a bunch of junk. The result should be only the char(10) and the date.

      Some cells might have two dates that are separated with a char(10) and I want to keep both dates and the char(10).

    • #1126629 Reply

      debaser
      AskWoody_MVP

      You could try something like this:

      Sub ReplaceNonDateOrLf()
      
      Dim RegExp As Object
      
      Set RegExp = CreateObject("vbscript.regexp")
      
       
      
      Dim MatchPattern As String
      
      MatchPattern = "(\n|^(0[1-9]|1[012])\/(0[1-9]|[12][0-9]|3[01])\/(19|20)\d\d$)"
      
       
      
      Dim SearchRange As Range
      
      Set SearchRange = Range("E6:R100")
      
       
      
      With RegExp
      
      .Global = True
      
      .Pattern = MatchPattern
      
      Dim cell As Range
      
      For Each cell In SearchRange.Cells
      
      Dim matches
      
      Set matches = .Execute(cell.Value)
      
      If matches.Count Then
      
      Dim match
      
      For Each match In matches
      
      Dim output As String
      
      output = output & match
      
      Next
      
      cell.Value = output
      
      End If
      
      Next
      
      End With
      
      End Sub
      
       
    • #1130641 Reply

      Paul T
      AskWoody MVP

      This pattern seems to match your requirements. It matches 0 to 1 new lines before a date.

      \n?((0[1-9])|[1-9]|(1[0-2]))\/(0[1-9]|[12][0-9]|3[01])\/(19|20)\d\d

      cheers, Paul

    • #1131374 Reply

      mn–
      AskWoody Lounger

      … these are always a bother.

      First question, are all dates known to always be in ‘month/day/year’ format with no leading zeroes, or is this locale-dependent?

      (There was this engineering tools vendor whose software expected fixed format strings in backend input but had the frontend reader format things in system locale… had to do some ugly hacks to make it work for an end user in a locale with different standard delimiters.)

      Is it guaranteed that the date substrings are contiguous and/or quote-delimited? Because getting valid non-delimited date strings from a bunch of what might randomly be numbers and punctuation can be a problem, even if they’re all contiguous.

      I’d want to pass potential date strings to IsDate() for verification anyway, because just checking for correct number of days in each month is a bother otherwise. Let alone leap years…

      (See also the recent Japanese date handling patches.)

    • #1134300 Reply

      krweaver
      AskWoody Lounger

      debaser: Thanks! However, it was TOO good…it erased multiple dates as well.

      In the attached, I’ve shown three cells. The first has the date and no LF and I want to retain the date; the 2nd has a LF, then a date and I want everything below and including the dashes (yes, including that other date) removed; the 3rd shows 2 days with a LF between the two dates and, again, everything below and including the dashes needs to be removed.

      Clip0002

      Attachments:
    • #1135936 Reply

      Paul T
      AskWoody MVP

      My pattern takes leading zeros on the month and day into account.

      I suspect the “dim output” statement inside the “for each” will erase existing data. It needs to be before the “for each” so that the value is cleared before the loop.
      i.e.

      Dim output As String
      For Each match In matches
      output = output & match
      Next

      cheers, Paul

    • #1138059 Reply

      krweaver
      AskWoody Lounger

      Thanks for the advice, Paul, but it didn’t resolve the issue. Rather than forcing you to shoot in the dark, I wanted to attach a sample file.

      The system wouldn’t let me attach a macro-based file nor an xlsx file nor a binary.  So, I don’t know how to send you a sample.

      Here’s the revised macro I’m using, but it populated the cells with a number of dates!

      Code:
      Sub ReplaceNonDateOrLf()
      
      Dim RegExp As Object
      Set RegExp = CreateObject("vbscript.regexp")
      Dim MatchPattern As String
      
      ' MatchPattern = "(\n|^(0[1-9]|1[012])\/(0[1-9]|[12][0-9]|3[01])\/(19|20)\d\d$)"
      ' From Paul T
      MatchPattern = "\n?((0[1-9])|[1-9]|(1[0-2]))\/(0[1-9]|[12][0-9]|3[01])\/(19|20)\d\d"
      
      Dim SearchRange As Range
      Set SearchRange = Range("E6:R100")
      
      With RegExp
      .Global = True
      .Pattern = MatchPattern
      Dim cell As Range
      
      For Each cell In SearchRange.Cells
      Dim matches
      Set matches = .Execute(cell.Value)
      If matches.Count Then
      Dim match
      Dim output As String ' moved here from below For per Paul T
      For Each match In matches
      
      output = output & match
      Next
      
      cell.Value = output
      End If
      Next
      End With
      
      End Sub
      • #1138351 Reply

        PKCano
        Da Boss

        At present, the only files that can be attached are pictures (jpg, jpeg, png, etc) with a maximum size of 1MB.

        1 user thanked author for this post.
        • #1171384 Reply

          woody
          Da Boss

          And we’re working on a fix.

          Good to see that posting code works, though.

    • #1141522 Reply

      krweaver
      AskWoody Lounger

      Paul, since I can’t post a sample file, maybe you can create one and use the info shown in this picture:

      Clip0002-1

      Attachments:
    • #1142115 Reply

      krweaver
      AskWoody Lounger

      This routine will clear everything from a cell except dates, but I want to retain the LF as well and this one completely clears cells that have the LF because it disqualifies as a date.

      Code:
      Sub DeleteNonDates()
      Dim r As Range, a As Range, cl As Range
      Set r = Sheets("Input").Range("E6:R100")
      For Each cl In r.Cells
      If TypeName(cl.Value) <> "Date" Then
      cl.ClearContents
      End If
      Next
      End Sub

      Could this be modified? I just can’t figure out how.

    • #1156170 Reply

      krweaver
      AskWoody Lounger

      I managed to get a workaround. Thanks for the tips and help.

    • #1157971 Reply

      Paul T
      AskWoody MVP

      And it was?

      cheers, Paul

    • #1171348 Reply

      krweaver
      AskWoody Lounger

      I had to do various calculations on the input sheet and create a new output sheet. The output (reformatted) sheet had only 1 date/cell and generally some LF (1, 2, or even possibly 3) in the hundreds of cells. So, I ultimately didn’t have to mess with cleaning up the input sheet (first) and only needed to clean up the output sheet at the end. So, I removed the non-dates and the LF in the output sheet using these two macros:

      Code:
      Sub RemoveLFs()
      Dim MyRange As Range
      Application.ScreenUpdating = False
      Application.Calculation = xlCalculationManual
      
      For Each MyRange In Worksheets("Reformatted").UsedRange
      If 0 < InStr(MyRange, Chr(10)) Then
      MyRange = Replace(MyRange, Chr(10), "")
      End If
      Next
      
      Application.ScreenUpdating = True
      Application.Calculation = xlCalculationAutomatic
      End Sub
      
      Sub DeleteNonDates()
      Dim r As Range, LR As Long, cl As Range
      LR = Sheets("Reformatted").Range("A" & Rows.Count).End(xlUp).Row
      Set r = Sheets("Reformatted").Range("E6:AF" & LR)
      For Each cl In r.Cells
      If TypeName(cl.Value) <> "Date" Then
      cl.ClearContents
      End If
      Next
      End Sub

      Again, thanks for your suggestions.

      1 user thanked author for this post.

    Please follow the -Lounge Rules- no personal attacks, no swearing, and politics/religion are relegated to the Rants forum.

    Reply To: VBA delete cell content with EXCEPTION(s)

    You can use BBCodes to format your content.
    Your account can't use Advanced BBCodes, they will be stripped before saving.