On Wed, 6 Feb 2013 22:59:16 +0000, Harry827 wrote:
I've got cells with a range of values and different units.
Here's an example of what I'm looking for..
1 apple (appl) = 3 oranges (org)
14 apples (appl) = 1 bananas (bans)
What I've got:
___A_____________B________
1__Item_________Value
2__Spam________1.25 org
3__Beef_________1.25-1.75 org
4__Chicken______2-2.75 appl
5__Steak________2-2.5 bans
What I'd like to do is split the range of each items value into separate
cells, a low and a high. On top of this, I'm trying to convert all of
the values into oranges. Sometimes the item values don't have a range,
sometimes they do.
What I'm looking for:
____A________B_______________C_________D
1__ITEM______VALUE__________LOW______HIGH
2__Spam______1.25 org________1.25_______
3__Beef_______1.25-1.75 org____1.25______1.75
4__Chicken____2-2.75 appl_______6________8.25
5__Steak______2-2.5 bans_______84_______105
Any help would be greatly appreciated. Thanks in advance!
Relatively easy with a macro.
To enter this Macro (Sub), <alt-F11 opens the Visual Basic Editor.
Ensure your project is highlighted in the Project Explorer window.
Then, from the top menu, select Insert/Module and
paste the code below into the window that opens.
To use this Macro (Sub), <alt-F8 opens the macro dialog box. Select the macro by name, and <RUN.
=============================================
Option Explicit
Option Compare Text
Sub Oranges()
Dim vSrc As Variant
Dim rSrc As Range
Dim i As Long
Dim dMult As Double
Dim re As Object, mc As Object
Set rSrc = Range("A1", Cells(Rows.Count, "B").End(xlUp))
vSrc = rSrc
ReDim Preserve vSrc(1 To UBound(vSrc, 1), 1 To 4)
vSrc(1, 1) = "ITEM"
vSrc(1, 2) = "VALUE"
vSrc(1, 3) = "LOW"
vSrc(1, 4) = "HIGH"
Set re = CreateObject("vbscript.regexp")
With re
.Global = True
.Pattern = "(\b\d+(?:\.\d+)?\b)\D*?(\b\d+(?:\.\d+)?\b)?\D *?([a-z]+)"
.ignorecase = True
For i = 2 To UBound(vSrc, 1)
If .test(vSrc(i, 2)) = True Then
Set mc = .Execute(vSrc(i, 2))
Select Case mc(0).submatches(2)
Case Is = "org"
dMult = 1
Case Is = "appl"
dMult = 3
Case Is = "bans"
dMult = 14 * 3
Case Else
dMult = 0 'or some kind of error message
End Select
vSrc(i, 3) = dMult * mc(0).submatches(0)
vSrc(i, 4) = IIf(mc(0).submatches(1) = "", "", dMult * mc(0).submatches(1))
End If
Next i
End With
rSrc.Resize(columnsize:=4) = vSrc
rSrc.EntireColumn.AutoFit
End Sub
==============================