ChristineJ
Well-known Member
- Joined
- May 18, 2009
- Messages
- 761
- Office Version
- 365
- Platform
- Windows
This macro looks at the formulas in range F6:F9 and returns the numbers (those that are not cell references) beginning in column N6 and moving right, with one number per cell.
For example, the formula in F6 is =A1+200+44+B2-12, so 200 appears in N6, 44 appears in O6, and 12 appears in P6 when the macro runs. Likewise, the formula in F9 is =5+6+7+8+J10, so 5, 6, 7, and 8 appear in N9, O9, P9, and Q9 respectively.
What would need to be changed in this code if the formulas are instead in range F6:G7 rather than F6:F9? The results should still begin in N6:N9 --- F6 would start in N6, F7 would start in N7, G6 would start in N8, and G7 would start in N9.
The Nums1 screenshot is what I have now and the Nums2 is what I'd like to change to.
Thanks!
For example, the formula in F6 is =A1+200+44+B2-12, so 200 appears in N6, 44 appears in O6, and 12 appears in P6 when the macro runs. Likewise, the formula in F9 is =5+6+7+8+J10, so 5, 6, 7, and 8 appear in N9, O9, P9, and Q9 respectively.
What would need to be changed in this code if the formulas are instead in range F6:G7 rather than F6:F9? The results should still begin in N6:N9 --- F6 would start in N6, F7 would start in N7, G6 would start in N8, and G7 would start in N9.
Code:
Sub Get_Nums()
Dim a As Variant
Dim RX As Object
Dim i As Long
Set RX = CreateObject("VBScript.RegExp")
RX.Global = True
a = Range("F6:F9").Formula
For i = 1 To UBound(a)
RX.Pattern = "([A-Z]\$?[0-9]+)|(" & Chr(34) & ".*?" & Chr(34) & ")"
a(i, 1) = RX.Replace(a(i, 1), "x")
RX.Pattern = "[^\d\.]"
a(i, 1) = Replace(Application.Trim(RX.Replace(a(i, 1), " ")), " ", ", ")
Next i
Range("N6:N9").Resize(UBound(a)).Value = a
If Range("N6").Value > 0 Then
Range("N6:N9").TextToColumns Destination:=Range("N6"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=True, Space:=False, Other:=False, FieldInfo _
:=Array(Array(1, 1), Array(2, 1)), TrailingMinusNumbers:=True
End If
End Sub
The Nums1 screenshot is what I have now and the Nums2 is what I'd like to change to.
Thanks!