VBA Button to clear column of text and leave just numbers

[daltendavis]

I am pasting into column A row 1 and need a macro I can apply to a button that takes out all text from what has been pasted and leaves every row with the same digits just without text.

Often times there will be up to 75 rows pasted in column A.

I need a macro that I can apply to a button to just pull the text out of the numbers leaving them in the same location on the sheet so I can then click another button which I have set up to value the numbers in the column.

Thank you

 

[daltendavis]

An example of something Pasted would be:

[TABLE="width: 173"]
<colgroup><col></colgroup><tbody>[TR]
[TD]* 983 - 153[/TD]
[/TR]
[TR]
[TD]CLM CHEP[/TD]
[/TR]
[TR]
[TD]077[/TD]
[/TR]
[TR]
[TD]*508 - 551[/TD]
[/TR]
[TR]
[TD]40Pal 888[/TD]
[/TR]
[TR]
[TD]2 Con 093[/TD]
[/TR]
[TR]
[TD]703[/TD]
[/TR]
[TR]
[TD]132 - 043 - 049 - 073[/TD]
[/TR]
[TR]
[TD][/TD]
[/TR]
</tbody>[/TABLE]
An example of the Output would be:

983 153 (The * and - can be left as long as they are not all on the same string)

077
508 551 (Or *508 - 551)
40 888
2 093
703
132 043 049 073 (Or 132 - 043 - 049 - 073)

Thank you again

 

[Rick Rothstein]

Give this macro a try...

Sub NumbersAndSpacesOnly()
  Dim R As Long, X As Long, Txt As String
  Application.ScreenUpdating = False
  For R = 1 To Cells(Rows.Count, "A").End(xlUp).Row
    Txt = Cells(R, "A").Value
    For X = 1 To Len(Txt)
      If Mid(Txt, X, 1) Like "[!0-9 ]" Then Mid(Txt, X) = " "
    Next
    Cells(R, "A").Value = Application.Trim(Txt)
  Next
  Application.ScreenUpdating = True
End Sub

 

[daltendavis]

This macro works however it does not allow my other macro to add a value to the numbers after. Here is the link for what I am using, the second macro in the multiple macro response: https://www.mrexcel.com/forum/excel...s-having-multiple-numbers-them-using-vba.html

 

[Rick Rothstein]

This macro works however it does not allow my other macro to add a value to the numbers after. Here is the link for what I am using, the second macro in the multiple macro response: https://www.mrexcel.com/forum/excel...s-having-multiple-numbers-them-using-vba.html

That second macro has this description above it... "Also try this for your other thread:". What "other thread" is Mick referring to? Hopefully the "other thread" will describe what you are wanting the code to do so that I don't have to try and dissect Mick's code without some kind of background as to what it is doing.

 

[daltendavis]

Sub MG26Jun30
Dim Rng As Range, Dn As Range, n As Long, Sp As Variant, Q As Variant, K As Variant
Dim c As Long
Set Rng = Range(Range("A1"), Range("A" & Rows.Count).End(xlUp))
With CreateObject("scripting.dictionary")
.CompareMode = vbTextCompare
For Each Dn In Rng
Dn.Value = IIf(Left(Dn.Value, 1) = "*", Mid(Dn.Value, 2), Dn.Value)
Sp = Split(Dn.Value, "-")
For n = 0 To UBound(Sp)
If Not .exists(Sp) Then
.Add Sp, Array(UBound(Sp) + 1, 1)
Else
Q = .Item(Sp)
Q(1) = Q(1) + 1
.Item(Sp) = Q
End If
Next n
Next
ReDim Ray(1 To .Count * 10, 1 To 2)
For Each K In .keys
c = c + 1
Ray(c, 1) = K
Ray(c, 2) = Format(Val(.Item(K)(1)) / Val(.Item(K)(0)), "0.00")
Next K
Sheets("Sheet2").Range("A1").Resize(c, 2) = Ray
End With
End Sub


This is the code I am currently using to apply a value to each individual number in each cell


The "Other Thread is the link as follows sorry for the confusion:
https://www.mrexcel.com/forum/excel-questions/1060883-assigning-value-based-count-numbers-specific-coumn.html

 

[Rick Rothstein]

So after removing all of the letters, you want each number in its own cell and you want a fractional amount (1 divided by the number of numbers in the cell) next to each number, is that correct? If so, does the code that does this have to be in a separate macro or would it be alright if I expanded my code from Message #3 above to perform the splitting of the numbers into their own cells along with the fractional amount next to it?

 

[daltendavis]

yes. The Idea is to paste it clear the letters with a button value the numbers which represent a store with another button. So you could expand on your code. For example when I paste in:
[TABLE="width: 173"]
<colgroup><col></colgroup><tbody>[TR]
[TD]118 - 938 - 048[/TD]
[/TR]
[TR]
[TD]850 - 407[/TD]
[/TR]
[TR]
[TD]OFF[/TD]
[/TR]
[TR]
[TD]Ads 829 - 019[/TD]
[/TR]
[TR]
[TD]165 - 132 - 049 - 043


[/TD]
[/TR]
</tbody>[/TABLE]

I need it to return:
118 .33
938 .33
048 .33
850 .5
407 .5
829 .5
019 .5
165 .25
132 .25
043 .25
049 .25

Above: first column A second column B

The problem I ran into is that it was not returning 829 as .5 it considered it to be Ads 829 as .5.
I figured just simply adding a button to remove the text from the column while keeping the same macro on my value button would solve it.

 

[Rick Rothstein]

Give this macro a try on your original data (with all the text characters in the cells along with the numbers) and see if it does what you want...

[table="width: 500"]
[tr]
	[td]Sub NumbersAndFractionalAmounts()
  Dim R As Long, X As Long, Fract As Double
  Dim Combo As String, Txt As String, Vals() As String
  For R = 1 To Cells(Rows.Count, "A").End(xlUp).Row
    Txt = Cells(R, "A").Value
    For X = 1 To Len(Txt)
      If Mid(Txt, X, 1) Like "[!0-9 ]" Then Mid(Txt, X) = " "
    Next
    Txt = Application.Trim(Txt)
    If Len(Txt) Then
      Fract = Format(1 / (Len(Txt) - Len(Replace(Txt, " ", "")) + 1), ".##")
      Txt = Replace(Txt, " ", "|" & Fract & " ") & "|" & Fract
    End If
    Combo = Combo & " " & Txt
  Next
  Vals = Split(Application.Trim(Combo))
  Range("A1").Resize(UBound(Vals) + 1) = Application.Transpose(Vals)
  Columns("A").TextToColumns , xlDelimited, , , False, False, False, False, True, "|", Array(Array(1, 2), Array(2, 1))
End Sub[/td]
[/tr]
[/table]

 

[daltendavis]

This is what I want it to do but can it export the results to sheet 2 of the workbook rather than just replacing where I pasted the data. Thank you very much