VBA Remove/Delete Leading Zeros

[rplohocky]

Hello,
I need to remove the leading zeros in column J. It would need to remove from alphanumeric strings. Can some one provide the VBA code to do this?

Thanks!

 

[ranman256]

do alpha start at col 1?
are they random letters mixed?
is it all zeros in the front of the cell, or mixed w alphas?

 

[Joe4]

Try this code:

Sub FixLeadingZeroes()

    Dim lastRow As Long
    Dim r As Long
    Dim i As Long
    Dim ln As Long
    Dim myString As String
    
    Application.ScreenUpdating = False
    
'   Find last row with data in column J
    lastRow = Cells(Rows.Count, "J").End(xlUp).Row
    
'   Loop through all entries in column J
    For r = 1 To lastRow
        myString = Cells(r, "J")
'       Find length of entry
        ln = Len(myString)
'       Loop through entries
        If ln > 0 Then
            For i = 1 To ln
                If Mid(myString, 1, 1) = "0" Then
                    myString = Mid(myString, 2)
                Else
                    Exit For
                End If
            Next i
'           Populate cell
            Cells(r, "J") = myString
        End If
    Next r
        
    Application.ScreenUpdating = True
    
End Sub

 

[Rick Rothstein]

Here is another macro that you can consider...

[table="width: 500"]
[tr]
	[td]Sub RemoveLeadingZeroes()
  Dim r As Long, CellVal As String
  For r = 1 To Cells(Rows.Count, "J").End(xlUp).Row
    CellVal = Replace(Replace(Cells(r, "J").Value, "E", Chr(1), , , vbTextCompare), "D", Chr(2), , , vbTextCompare)
    CellVal = Mid(CellVal, InStr(CellVal, Val(CellVal)))
    Cells(r, "J").NumberFormat = "@"
    Cells(r, "J").Value = Replace(Replace(CellVal, Chr(1), "E"), Chr(2), "D")
  Next
End Sub[/td]
[/tr]
[/table]

 

[rplohocky]

Try this code:

Sub FixLeadingZeroes()

    Dim lastRow As Long
    Dim r As Long
    Dim i As Long
    Dim ln As Long
    Dim myString As String
    
    Application.ScreenUpdating = False
    
'   Find last row with data in column J
    lastRow = Cells(Rows.Count, "J").End(xlUp).Row
    
'   Loop through all entries in column J
    For r = 1 To lastRow
        myString = Cells(r, "J")
'       Find length of entry
        ln = Len(myString)
'       Loop through entries
        If ln > 0 Then
            For i = 1 To ln
                If Mid(myString, 1, 1) = "0" Then
                    myString = Mid(myString, 2)
                Else
                    Exit For
                End If
            Next i
'           Populate cell
            Cells(r, "J") = myString
        End If
    Next r
        
    Application.ScreenUpdating = True
    
End Sub

Thanks Joe4! This seems to work perfectly!

Rick, I tried your code but it seemed to bugout. It's always nice to have a few options so I gave it a run.
<quote>
CellVal = Mid(CellVal, InStr(CellVal, Val(CellVal)))
</quote>
This line was what stopped it.

 

[Rick Rothstein]

Thanks Joe4! This seems to work perfectly!

Rick, I tried your code but it seemed to bugout. It's always nice to have a few options so I gave it a run.
<quote>
CellVal = Mid(CellVal, InStr(CellVal, Val(CellVal)))
</quote>
This line was what stopped it.

Can you tell me what Cells(r, "J").Value was equal to when the error occurred? If you are unsure of how to do this, run the code until the error stops it, then execute this line of code in the Immediate Window (press CTRL+G if you don't see this window)...

? Cells(r, "J").Value

 

[TotallyConfused]

Here is another macro that you can consider...

[TABLE="width: 500"]
<tbody>[TR]
[TD]Sub RemoveLeadingZeroes()
  Dim r As Long, CellVal As String
  For r = 1 To Cells(Rows.Count, "J").End(xlUp).Row
    CellVal = Replace(Replace(Cells(r, "J").Value, "E", Chr(1), , , vbTextCompare), "D", Chr(2), , , vbTextCompare)
    CellVal = Mid(CellVal, InStr(CellVal, Val(CellVal)))
    Cells(r, "J").NumberFormat = "@"
    Cells(r, "J").Value = Replace(Replace(CellVal, Chr(1), "E"), Chr(2), "D")
  Next
End Sub[/TD]
[/TR]
</tbody>[/TABLE]

Mr. Rothstein

I tried using this code. It worked, but not as I expected. I'm using Excel 2010, so perhaps that is the reason. What it did was to convert any lower case letters 'e' and lower case letters 'd' to upper case 'E' & 'D'. My three test samples in column 'J' of '00asd' & '0sdfg' & '0000qwe0rt0' were changed to '00asD' & 0sDfg' and '0000qwE0rt0'. Those are all zero's and not 'Oh's. When I ran the code a second time using the upper case 'D & E' samples, nothing happened.

I'm going to keep a sample of this code in case someday I need to convert letters from one case to another.

TotallyConfused

 

[Rick Rothstein]

Mr. Rothstein

I tried using this code. It worked, but not as I expected. I'm using Excel 2010, so perhaps that is the reason. What it did was to convert any lower case letters 'e' and lower case letters 'd' to upper case 'E' & 'D'. My three test samples in column 'J' of '00asd' & '0sdfg' & '0000qwe0rt0' were changed to '00asD' & 0sDfg' and '0000qwE0rt0'. Those are all zero's and not 'Oh's. When I ran the code a second time using the upper case 'D & E' samples, nothing happened.

This code is untested, but I am pretty sure it will remove the leading zeroes and preserve the letter casing for your D, d, E and e...

[table="width: 500"]
[tr]
	[td]Sub RemoveLeadingZeroes()
  Dim r As Long, CellVal As String
  For r = 1 To Cells(Rows.Count, "J").End(xlUp).Row
    CellVal = Replace(Replace(Replace(Replace(Cells(r, "J").Value, "E", Chr(1)), "D", Chr(2)), "e", Chr(3)), "d", Chr(4))
    CellVal = Mid(CellVal, InStr(CellVal, Val(CellVal)))
    Cells(r, "J").NumberFormat = "@"
    Cells(r, "J").Value = Replace(Replace(Replace(Replace(CellVal, Chr(1), "E"), Chr(2), "D"), Chr(3), "e"), Chr(4), "d")
  Next
End Sub[/td]
[/tr]
[/table]

 

[TotallyConfused]

This code is untested, but I am pretty sure it will remove the leading zeroes and preserve the letter casing for your D, d, E and e...

[TABLE="width: 500"]
<tbody>[TR]
[TD]Sub RemoveLeadingZeroes()
  Dim r As Long, CellVal As String
  For r = 1 To Cells(Rows.Count, "J").End(xlUp).Row
    CellVal = Replace(Replace(Replace(Replace(Cells(r, "J").Value, "E", Chr(1)), "D", Chr(2)), "e", Chr(3)), "d", Chr(4))
    CellVal = Mid(CellVal, InStr(CellVal, Val(CellVal)))
    Cells(r, "J").NumberFormat = "@"
    Cells(r, "J").Value = Replace(Replace(Replace(Replace(CellVal, Chr(1), "E"), Chr(2), "D"), Chr(3), "e"), Chr(4), "d")
  Next
End Sub
[/TD]
[/TR]
</tbody>[/TABLE]

Hello Rick

This version of your code did work as it removed the leading zero's and moved everything to the left of the cell. THANK YOU for your help. I'm not sure why the lines that talk about 'Replace' and 'Mid....' are there, as I believe the original question was about removing leading zeros. I'm new to Excel so I've been studying each line and experimenting to learn how each one works. Thanks again for your help.

TotallyConfused