Serial numbers and ZEROS

[emukiss10]

Hello,

I have a problem with disapearing zeros..

my formula so far to copy proper numbers to other sheet is:

Dim cellR As RangeDim lastRowR As Long, r As Long


lastRowR = Range("J" & Rows.Count).End(xlUp).row
r = 2


For Each cellR In Sheets(1).Range("J1:J" & lastRowR)
     If Len(cellR) = 9 Or Len(cellR) = 14 Then
        cellR.EntireRow.Copy Sheets("SERIAL").Cells(r, 1)
        r = r + 1
    End If
Next

the problem is that the files that I need to work on have values in column J looking like this:

="00000000"
="029384756"
="000776819"
="284758933"

I need to copy entire rows to my new sheet if value in column J has 9 or 14 characters. The formating makes things difficult.

we can strip those numbers of ="" but than excel is removing leading zeros.

Anybody know how to bypass this?


Best Regards
W.

 

[Scott T]

If you record the number as text it will not drop any character.

Excel 2010[TABLE="class: grid, width: 500"]
<colgroup><col><col><col><col></colgroup><tbody>[TR="bgcolor: [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=DAE7F5]#DAE7F5[/URL] "]
[TD][/TD]
[TD]A[/TD]
[TD]B[/TD]
[TD]C[/TD]
[/TR]
[TR]
[TD="align: center"]1[/TD]
[TD="align: right"][/TD]
[TD]length[/TD]
[TD="align: right"][/TD]
[/TR]
[TR]
[TD="align: center"]2[/TD]
[TD="align: right"]02938756[/TD]
[TD="align: right"]8[/TD]
[TD]Formated as text with ' in front of the number[/TD]
[/TR]
[TR]
[TD="align: center"]3[/TD]
[TD="align: right"]02938756[/TD]
[TD="align: right"]7[/TD]
[TD]Formated as number with formatting for leading zero[/TD]
[/TR]
</tbody>[/TABLE]

Sheet1​

[TABLE="width: 85%"]
<tbody>[TR]
[TD]Worksheet Formulas[TABLE="class: grid, width: 100%"]
<tbody>[TR="bgcolor: [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=DAE7F5]#DAE7F5[/URL] "]
[TD="width: 10"]Cell[/TD]
[TD="align: left"]Formula[/TD]
[/TR]
[TR]
[TH="width: 10, bgcolor: [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=DAE7F5]#DAE7F5[/URL] "]B2[/TH]
[TD="align: left"]=LEN(A2)[/TD]
[/TR]
[TR]
[TH="width: 10, bgcolor: [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=DAE7F5]#DAE7F5[/URL] "]B3[/TH]
[TD="align: left"]=LEN(A3)[/TD]
[/TR]
</tbody>[/TABLE]
[/TD]
[/TR]
</tbody>[/TABLE]

 

[emukiss10]

Can you modify my VBA scrip from first post to auto-do the trick? the problem is that column J has every value like this =" ******** " - within the quotes and with equal sign..

 

[Scott T]

Try

Dim cellR As Range
Dim lastRowR As Long, r As Long

lastRowR = Range("J" & Rows.Count).End(xlUp).Row
For x = 2 To lastRowR
    Cells(x, "J") = "'" & Cells(x, "J")
Next x

r = 2
For Each cellR In Sheets(1).Range("J1:J" & lastRowR)
     If Len(cellR) = 9 Or Len(cellR) = 14 Then
        cellR.EntireRow.Copy Sheets("SERIAL").Cells(r, 1)
        r = r + 1
    End If
Next

 

[emukiss10]

Nice!

One more request.. Can you make it skip ="000000000" ?

I do not want "0" nor "000000000".

 

[Scott T]

Try

Dim cellR As Range
Dim lastRowR As Long, r As Long

lastRowR = Range("J" & Rows.Count).End(xlUp).Row
For x = 2 To lastRowR
    
    Cells(x, "J") = "'" & Cells(x, "J")
Next x

r = 2
For Each cellR In Sheets(1).Range("J1:J" & lastRowR)
     If (Len(cellR) = 9 Or Len(cellR) = 14) And cellR <> 0 Then
        cellR.EntireRow.Copy Sheets("SERIAL").Cells(r, 1)
        r = r + 1
    End If
Next

 

[emukiss10]

nope, does not work. But ive work it around deleting 0'os from copied rows.

 

[emukiss10]

Hi Again!

Scott T, Your work is great!

I have another mod to do..

When my script i looking for numbers (nine or fourteen chars) ="123456789", sometimes there is an 10th, 11th / 15th, 16th char and it looks like this 123456789/P or 987654321/2 or 875639275/+. Can macro look for two last chars and accept them as correct even if its above 9 or 14 char when there is SLASH (/) at 10 or 15?

Best Regards
W.

 

[Scott T]

Does this do what you want?

Dim cellR As Range
Dim lastRowR As Long, r As Long
lastRowR = Range("J" & Rows.Count).End(xlUp).Row
For x = 2 To lastRowR
    
    Cells(x, "J") = "'" & Cells(x, "J")
Next x
r = 2
For Each cellR In Sheets(1).Range("J1:J" & lastRowR)
     If (Len(cellR) = 9 Or Len(cellR) = 14 Or Mid(cellR, 10, 1) = "/" Or Mid(cellR, 15, 1) = "/") And cellR <> 0 Then
        cellR.EntireRow.Copy Sheets("SERIAL").Cells(r, 1)
        r = r + 1
    End If
Next

 

[emukiss10]

Maaaaann....
Yes. :D