Excel - Extract only numeric fields from a selection containing text and numbers

Question

Using Excel, I need to extract numerical data from a selection. Example:

Coluna 1
123
456
Bom
Ruim
789
Ótimo

From the above data, I need to extract the following data:

Coluna 2
123
456
789

Answer 1

A solution in VBA would be to use the procedure below. Note that it is generic, not only for what is selected. You pass an object of the Range type and it iterates through all cells that make up this range.

Sub excluiLinhasNaoNumericasOuVazias(range As range)
      Dim celulasParaDeletar As Scripting.Dictionary
      Dim r As range

      Set celulasParaDeletar = New Scripting.Dictionary

      For Each r In range
         If Not IsNumeric(r.Value) Or r.Value = "" Then
             celulasParaDeletar.Add CStr(r.Row), r
          End If
      Next

      For i = 0 To celulasParaDeletar.Count - 1
          celulasParaDeletar.Items(i).Delete
      Next
End Sub

This solution uses a dictionary-like object to store lines that need to be deleted. You cannot delete in a loop that iterates over cells, because deleting a line changes the original range passed as parameter. Consequently, some lines that need to be deleted are not.

To use the Scripting.Dictionary class you must include a reference called Microsoft Scripting Runtime.

The function isNumeric() is used to determine whether the contents of a cell are a number or not. Empty cells are considered numbers by Excel, because of this, it is necessary to test whether the content is empty.

Below a test for this solution:

Sub teste()
    excluiLinhasNaoNumericasOuVazias Selection
End Sub

It is assumed that cells need to be selected in the worksheet, since an object of type Selection is being passed as parameter.

Answer 2

Solution found:

1. I created a function to delete a string in a function:

   Function deleteString(ByVal STRING_TO_BE_DELETED As String)
   '
   ' Deleta um texto específico
   ' IMPORTANTE: A origem já deve estar selecionado
   '
       Selection.Replace What:=STRING_TO_BE_DELETED, Replacement:="", LookAt:=xlPart, _
           SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
           ReplaceFormat:=False
   End Function
   

2. Another function to delete blank cells:

   Function deleteBlank(Optional NOT_IN_USE As Boolean)
   '
   ' Deleta espaços em brancos
   ' IMPORTANTE: Os dados já devem vir selecionados
   '
       Selection.SpecialCells(xlCellTypeBlanks).Select
       Selection.EntireRow.delete
   End Function
   

3. A function that calls these two, unique that will be called by the macro:

   Function deleteString_Blank(ByVal RANGE_SELECTION As Range, ByVal LIST_TO_BE_DELETED As String)
   '
   ' Deleta texto de uma seleção
   '
   Dim arr As Variant
   Dim i As Integer
       RANGE_SELECTION.Select
       arr = Range(LIST_TO_BE_DELETED)
       For i = LBound(arr, 1) To UBound(arr, 1)
           deleteString arr(i, 1)
       Next i
       deleteBlank
   End Function
   

4. And put the code that calls the functions and sends the variables:

   deleteString_Blank Columns(1), "NOME_DA_LISTA"
   

Remembering that the number '1' in Columns(1) is the selected column and "NOME_DA_LISTA" shall be the named range containing the data to be deleted from the data ranges. In my case the list is a table with the following options, following the example above (the question):

Good

Bad

Great

I hope I’ve helped!

Answer 3

You can also try using another formula, I don’t know why, whenever I use SpecialCells(xlCellTypeBlanks),error - So I chose to try for autofilter:

Sub seleciona_numeros()
Dim ultimalinha As Integer

'identifica ultima linha
ultimalinha = Range("A" & Rows.Count).End(xlUp).Row

'escreve COL2 na coluna B e verifica o que é numero na coluna A
    Range("B1").FormulaR1C1 = "COL2"
    Range("B2").FormulaR1C1 = "=IF(ISNUMBER(RC[-1]),RC[-1],"""")"

'aplica a formula até a ultima linha
    Range("B2").Copy
    Range("B2:B" & ultimalinha).PasteSpecial xlPasteAll
    Application.CutCopyMode = False

'exclui as formulas colando como valores
    Range("B2:B" & ultimalinha).Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False

'filtra e exclui as linhas vazias

    Range("B:B").Select
    ActiveSheet.Range("$A$1:$B$" & ultimalinha).AutoFilter Field:=2, Criteria1:="="

    Application.DisplayAlerts = False
    ActiveSheet.UsedRange.Offset(1, 0).Resize(ActiveSheet.UsedRange.Rows.Count - 1).Rows.Delete
    Application.DisplayAlerts = True
    ActiveSheet.ShowAllData

End Sub