Dellete column F all the values that dont have 3 digits

[Excelnewbie001]

Hope someone can help I am looking for a macro to delete all the values in colum F that dont have 3 digits. here is a sample data so in this sample below 1,3, must be deleted 2,,2 must be deleted. 4,, must be deleted. So only Numbers with 3 digits must not be deleted.Thanks for any help -this must be simple for vba programmer

1, 2, 1
1, 3,
1, 3, 0
2, , 2
2, 2, 0
2, 1, 1
3, , 1
3, 1, 0
4, ,
4, , 0
4, 0, 0
, , 4
, 4, 0

 

[oldbrewer]

if there is always a space after a comma, delete all cells where len= <7
for j=1 to 1000
if len(cells(j,1))<7 then cells(1,1)=""
next j
end sub

 

[Excelnewbie001]

if there is always a space after a comma, delete all cells where len= <7
for j=1 to 1000
if len(cells(j,1))<7 then cells(1,1)=""
next j
end sub

Yes there is a space after a comma but in this case there is 2 numbers missing and only ,, >>>>> , , 4

 

[Excelnewbie001]

if there is always a space after a comma, delete all cells where len= <7
for j=1 to 1000
if len(cells(j,1))<7 then cells(1,1)=""
next j
end sub

Is this correct ?

Sub Deletechar
for j=1 to 1000
if len(cells(j,1))<7 then cells(1,1)=""
next j
end sub
[CODE]

 

[Excelnewbie001]

Is this correct ?

Sub Deletechar
for j=1 to 1000
if len(cells(j,1))<7 then cells(1,1)=""
next j
end sub
[CODE][/QUOTE]


Dont work...the data is in column F ??

 

[Peter_SSs]

Try this

Sub Del_Values()
  Dim a As Variant
  Dim i As Long
  
  a = Range("F1", Range("F" & Rows.Count).End(xlUp)).Value
  For i = 1 To UBound(a)
    If Not a(i, 1) Like "#, #, #" Then a(i, 1) = Empty
  Next i
  Range("F1").Resize(UBound(a)).Value = a
End Sub

 

[Excelnewbie001]

Try this

Sub Del_Values()
  Dim a As Variant
  Dim i As Long
  
  a = Range("F1", Range("F" & Rows.Count).End(xlUp)).Value
  For i = 1 To UBound(a)
    If Not a(i, 1) Like "#, #, #" Then a(i, 1) = Empty
  Next i
  Range("F1").Resize(UBound(a)).Value = a
End Sub

Peter your a legend it works but may I please ask you just to move the data up with other words delete empty cells -then its perfect -Thank you for the code thus far its spot on -See below the output but there is spaces if I can move it up it will be 100% thank you you are very good

[TABLE="width: 145"]
<colgroup><col></colgroup><tbody>[TR]
[TD]1, 2, 1[/TD]
[/TR]
[TR]
[TD][/TD]
[/TR]
[TR]
[TD]1, 3, 0[/TD]
[/TR]
[TR]
[TD][/TD]
[/TR]
[TR]
[TD]2, 2, 0[/TD]
[/TR]
[TR]
[TD]2, 1, 1[/TD]
[/TR]
[TR]
[TD][/TD]
[/TR]
[TR]
[TD]3, 1, 0[/TD]
[/TR]
[TR]
[TD] [/TD]
[/TR]
[TR]
[TD] [/TD]
[/TR]
[TR]
[TD]4, 0, 0[/TD]
[/TR]
</tbody>[/TABLE]

 

[Peter_SSs]

.t may I please ask you just to move the data up with other words delete empty cells

Sure

Sub Del_Values_v2()
  Dim a As Variant, b As Variant
  Dim i As Long, k As Long
  
  a = Range("F1", Range("F" & Rows.Count).End(xlUp)).Value
  ReDim b(1 To UBound(a), 1 To 1)
  For i = 1 To UBound(a)
    If a(i, 1) Like "#, #, #" Then
      k = k + 1
      b(k, 1) = a(i, 1)
    End If
  Next i
  Range("F1").Resize(UBound(b)).Value = b
End Sub

 

[Rick Rothstein]

Here is another macro that you can try...

[table="width: 500"]
[tr]
	[td]Sub Del_Values()
  Dim Addr As String
  Addr = "F1:F" & Cells(Rows.Count, "F").End(xlUp).Row
  Range(Addr) = Evaluate(Replace("IF(ISNUMBER(FIND("",,"",SUBSTITUTE("",""&@&"","","" "",""""))),"""",@)", "@", Addr))
End Sub[/td]
[/tr]
[/table]

 

[footoo]

Another possibility :

Sub Foo()
Dim r$
r = Range([F1], Cells(Rows.Count, "F").End(xlUp)).Address
Range(r) = Evaluate("=IF(LEN(" & r & ")<7,""""," & r & ")")
End Sub