Why is my code ignoring underscores? - string

Question

I am writing a very simple vba code that is designed to iterate through the letters/numbers in each cell in row 2 and only keep the numbers in the beginning. Each cell starts with between 4 and 7 numbers, and then will be followed by either a letter (1 or more), a . and a number, or an underscore and a letter and a number.
The issue I am having is that my code is only returning the correct values for some of the cells. Only the cells that have a . are cleaned correctly. The ones with the underscore delete everything after the _, but keep the _ itself and the cells with letters keep the letters but delete the . and anything after it.
This is my code:
Sub getIDs()
Dim counter As Integer
counter = 1
Dim rowCounter As Integer
rowCounter = 2
Dim original As String
original = ""
Dim newText As String
newText = ""
Do While Len(Cells(rowCounter, 2)) > 0
Do While counter <= Len(Cells(rowCounter, 2))
If Not IsNumeric((Mid(Cells(rowCounter, 2).Value, counter, 1))) Or Mid(Cells(rowCounter, 2).Value, counter, 1) = "_" Then
Exit Do
Else
counter = counter + 1
End If
Loop
newText = Left(Cells(rowCounter, 2), counter)
Cells(rowCounter, 2) = newText
rowCounter = rowCounter + 1
Loop
End Sub
Examples: The original cells contain these four types of info (numbers vary):
Input Desired output Actual output Actual output OK?
----------------|-----------------|--------------|-------------------------
12345_v2.jpg 12345 12345_ No, "_" should be removed
293847.psd 293847 293847 OK
82364382.1.tga 82364382 82364382 OK
172982C.5.tga 172982 172982C No, "C" should be removed

Answer 1

So I found two problems with your code. The first that counter, really needs to be counter-1 when you set new text since that is the position of the non-numeric or underscore character. Copying at the counter point will give you an extra character.
The second issue is that you need to reset the counter variable outside of the inner Do loop, otherwise you will start at the position of the previous last found character. Try this.
Sub getIDs()
Dim counter As Integer
counter = 1
Dim rowCounter As Integer
rowCounter = 2
Dim original As String
original = ""
Dim newText As String
newText = ""
Do While Len(Cells(rowCounter, 2)) > 0
counter = 1
Do While counter <= Len(Cells(rowCounter, 2))
If Not IsNumeric((Mid(Cells(rowCounter, 2).Value, counter, 1))) Or Mid(Cells(rowCounter, 2).Value, counter, 1) = "_" Then
Exit Do
Else
counter = counter + 1
End If
Loop
newText = Left(Cells(rowCounter, 2), counter - 1)
Cells(rowCounter, 2) = newText
rowCounter = rowCounter + 1
Loop
End Sub

Answer 2

This will remove dots and underscores.
I have to run; no time to implement removing letters. But this should put you on the right track. I may continue tomorrow.
Sub lkjhlkjh()
Dim s As String
Dim iUnderscore As Long
Dim iDot As Long
Dim iCut As Long
s = Sheet1.Cells(1, 1)
iUnderscore = InStr(s, "_")
iDot = InStr(s, ".")
If iUnderscore = 0 Then
If iDot = 0 Then
'Don't cut
Else
iCut = iDot
End If
Else
If iDot = 0 Then
iCut = iUnderscore
Else
If iDot > iUnderscore Then
iCut = iUnderscore
Else
iCut = iDot
End If
End If
End If
If iCut > 0 Then s = Left(s, iCut - 1)
Sheet1.Cells(1, 1) = s
End Sub