VBA code to find cells with any value and replace with blank

[Roballistic]

Code throwing error:

OpenBook.Sheets(1).Range("I27:I526").Copy 'Copies Medical Plan Selection Column
ThisWorkbook.Worksheets("SMARTTemplate").Range("J2").PasteSpecial xlPasteValues 'Pastes copied values to new sheet
ThisWorkbook.Worksheets("SMARTTemplate").Range("J2:J501").Replace What:="Waive", Replacement:="WAIVE" 'Replaces any value within the copied data having value of "Waive" to all capitals "WAIVE"
ThisWorkbook.Worksheets("SMARTTemplate").Range("J2:J501").Replace What:<>"Waive", Replacement:="""" 'Compile error received on <>. I need the code to to look across the range and where there is anything not labeled "WAIVE" to replace whatever is in those cells to "ENROLL". And also need the blanks skipped.

Any help or suggestions are appreciated.

 

[Jeffrey Mahoney]

Please try this code

Sub WaiveEnroll()
  Dim Cel As Range
  Dim Rng As Range
  Dim wRng As Range
  Dim eRng As Range
  Dim aStr As String
  Dim SMSht As Worksheet
  
  Set SMSht = ThisWorkbook.Worksheets("SMARTTemplate")
  OpenBook.Sheets(1).Range("I27:I526").Copy 'Copies Medical Plan Selection Column
  SMSht.Range("J2").PasteSpecial xlPasteValues 'Pastes copied values to new sheet
  
  Set Rng = SMSht.Range("J2:J501")
  For Each Cel In Rng
    aStr = Cel.Value
    If aStr <> "" Then
      If aStr = "Waive" Then
        If Not wRng Is Nothing Then
          Set wRng = Union(wRng, Cel)
        Else
          Set wRng = Cel
        End If
      Else
        If Not eRng Is Nothing Then
          Set eRng = Union(eRng, Cel)
        Else
          Set eRng = Cel
        End If
      End If
    End If
  Next Cel
  If Not wRng Is Nothing Then wRng.Value "WAIVE"
  If Not eRng Is Nothing Then eRng.Value "ENROLL"
      

End Sub

 

[Roballistic]

Sub WaiveEnroll() Dim Cel As Range Dim Rng As Range Dim wRng As Range Dim eRng As Range Dim aStr As String Dim SMSht As Worksheet Set SMSht = ThisWorkbook.Worksheets("SMARTTemplate") OpenBook.Sheets(1).Range("I27:I526").Copy 'Copies Medical Plan Selection Column SMSht.Range("J2").PasteSpecial xlPasteValues 'Pastes copied values to new sheet Set Rng = SMSht.Range("J2:J501") For Each Cel In Rng aStr = Cel.Value If aStr <> "" Then If aStr = "Waive" Then If Not wRng Is Nothing Then Set wRng = Union(wRng, Cel) Else Set wRng = Cel End If Else If Not eRng Is Nothing Then Set eRng = Union(eRng, Cel) Else Set eRng = Cel End If End If End If Next Cel If Not wRng Is Nothing Then wRng.Value "WAIVE" If Not eRng Is Nothing Then eRng.Value "ENROLL" End Sub

Not quite working... getting the attached error. Any ideas?

 

[Roballistic]

Not quite working... getting the attached error. Any ideas?

So I thought (my first mistake) that maybe the Waive and Enroll needed to be in parenthesis, so changed that and then ran to only find the error seen in attached?

 

[Skyybot]

Try this:

If Not wRng Is Nothing Then wRng.Value = "WAIVE"
  If Not eRng Is Nothing Then eRng.Value  = "ENROLL"

 

[Jeffrey Mahoney]

Sorry

If Not wRng Is Nothing Then wRng.Value = "WAIVE"
  If Not eRng Is Nothing Then eRng.Value = "ENROLL"