VBA Replace Hyphens in a String Up to a Position

[beartooth91]

Well, have been struggling with various combinations of Replace and Mid to delete the hyphens in a string while leaving the last one, if its present.

The data to search and replace is in one of the following forms and can be up to a maximum of 20 characters:

1-SYS-CC-0001 #Result should be 1SYSCC0001

1-SYS-CC-0002-A #Result should be 1SYSCC0002-A

1SYSCCTEXT-FCT # Result should be the same, unchanged

I believe what I'm looking for is to search the first 9-10 characters in the string and delete all hyphens within those first 9-10 characters. I just haven't been able to come up with the correct VBA to do it.

Any ideas? Thanks.

 

[beartooth91]

So what is the logic that you want to apply?

We either need an explanation of the logic or representative examples of the data, all scenarios, and what you expect for each scenario.

The data to search and replace is in one of the following forms and can be up to a maximum of 20 characters:

1-SYS-CC-0001 #Result should be 1SYSCC0001

1-SYS-CC-0002-A #Result should be 1SYSCC0002-A

1SYSCCTEXT-FCT # Result should be the same, unchanged

Where: SYS is one of 40+ system codes and CC is one of 80+ instrument codes.

I believe what I'm looking for is to search the first 10 characters in the string and delete all hyphens within those first 10 characters. I just haven't been able to come up with the correct VBA to do it.

I did come up with the below that does seem to work:

Sub Remove_Hyphens()
'Removes hyphens from the Component Numbers in Column B

With ActiveSheet

 Dim LastRow&, a&, x&, searchPos&, newStr$, oldStr$, lStr$, rStr$
 
 LastRow = .Cells(Rows.Count, "B").End(xlUp).Row
 
 For x = 11 To LastRow
 '  cell.Value = Replace(cell.Value, "-", "", , 2)
   oldStr = Cells(x, "B").Value
   searchPos = InStr(1, oldStr, "-")
   lStr = Replace(Left(oldStr, 10), "-", "")
   rStr = Mid(oldStr, 11)
   newStr = lStr & rStr
   If newStr <> oldStr Then
     .Cells(x, "B").EntireRow.Interior.ColorIndex = 20
     .Cells(x, "B").Value = newStr
     a = a + 1
   End If
   
  Next x
 
 If a > 0 Then
   MsgBox (a & " point names were changed. Please review the Lt Blue highlighted rows.")
   
 Else
   MsgBox ("No point names were changed. Press 'Ok' to exit.")
   
 End If
  
End With
  
End Sub

 

[Scott Huish]

searchPos is not necessary

You had a different range but was similar to what I came up with it

Sub RemoveHyphens()
Dim lr As Long, c As Range, ts As String, te As String
lr = Range("A" & Rows.Count).End(xlUp).Row
For Each c In Range("A11:A" & lr)
ts = Replace(Left(c, 10), "-", "")
te = Mid(c, 11)
c.Offset(, 1) = ts & te
Next
End Sub

 

[Scott Huish]

I think this will do everything you are trying to do:

Sub RemoveHyphens()
Dim lr As Long, c As Range, ts As String, te As String, oldstring As String, ctr As Long, msg As String, newstring As String
msg = "No point names were changed. Press 'Ok' to exit."
lr = Range("B" & Rows.Count).End(xlUp).Row
For Each c In Range("B11:B" & lr)
oldstring = c.Text
ts = Replace(Left(c, 10), "-", "")
te = Mid(c, 11)
newstring = ts & te
If Len(newstring) < Len(oldstring) Then
    ctr = ctr + 1
    c.EntireRow.Interior.ColorIndex = 20
    msg = ctr & " point names were changed. Please review the Lt Blue highlighted rows."
End If
Next
MsgBox msg
End Sub