Breakout numbers from a string and use/store each number as a variable

[mmmaxmmm]

So I've got a bunch of cells going down column A with strings like the below examples and I would like to be able to use each number in an IF function. Is there a way to store each number in A1 as a variable that I can use in an IF function and then once all the numbers are stored and used, move on to the next cell A2 and do the same thing? So 1 would be stored as a variable, used in an IF function. Then 25 would be stored as a variable, used in an IF function, then 50. Then it would reset or something, move on to A2 and start looping it like that through the end of column A. If anyone can post code, the IF function could just be the most simplest thing you can think of. My issue here is all the other stuff, not the IF function. Thank you to anyone who may be able to help!




A1 might have this as text: 1CA/25EA/50
A2 might have this as text: 1CA/100EA/5000PR/1000

 

[mmmaxmmm]

I will look at it but it mightn't have sufficient time for a day or two.

Peter, even if it takes 2 weeks or a month I'd be eternally grateful. This macro, if created, would not only save me hours of manual labor every week but I think my boss would really appreciate it big time.

 

[Peter_SSs]

Hmm, before I delve into this, are you using a Mac version of Excel? If so, I don't think I will be able to help as I do not have such a set-up to test on.

 

[mmmaxmmm]

Hmm, before I delve into this, are you using a Mac version of Excel? If so, I don't think I will be able to help as I do not have such a set-up to test on.

No I'm using the newest version of Excel on a Windows based Lenovo laptop. Should be good to go!

 

[Peter_SSs]

OK, I was spooked by the HTML Maker screen shot showing "Excel 2012"
A newer version of the HTML Maker is being developed by one of the forum members, see here
Also, when using the HTML Maker, look for options to reduce the number of formulas shown. There is generally no need to display multiple formulas that are basically the same, it just fills up the board and makes your post and the thread hard to read/navigate.

Because I don't have all your columns of data/formulas or the 'New Price List' sheet, I cannot test this code so it is unlikely to work first off, but may point you in the right direction.

I actually think there would be a more direct way to test these numbers without having to physically test them in column Z. However, because of not having all the formulas etc, and also because it is likely too large a job for a free public forum like this, I have gone with the substitution into column Z. That in itself may have problems, depending on the complexity of your workbook. After a value is inserted in col Z, the code may move on too quickly before the sheet has calculated the new value for col AU. The problem would occur where I have marked some asterisks in the code and a bit more might be needed there.

Anyway, see if this does anything (in a copy of your workbook).

I have assumed the 'Detail' sheet is the active sheet when the code is run.

Sub TestNumbers()
  Dim RX As Object, Nums As Object
  Dim data As Variant
  Dim r As Long, j As Long, num As Long, OrigNum As Long
  Dim bChanged As Boolean
  
  Const HdrRow As Long = 6
  
  Set RX = CreateObject("VBScript.RegExp")
  RX.Global = True
  RX.Pattern = "\d+"
  data = Range("AC1", Range("AC" & Rows.Count).End(xlUp)).Value
  With Range("Z1").Resize(UBound(data))
    For r = HdrRow + 1 To UBound(data)
      Set Nums = RX.Execute(data(r, 1))
      OrigNum = Range("Z" & r).Value
        For j = 1 To Nums.Count
          num = Nums.Item(j - 1)
          .Cells(r).Value = num
          '******
          If Abs(Range("AU" & r).Value) <= 0.75 Then
            Range("Z" & r).Interior.ColorIndex = 45
            bChanged = True
            Exit For
          End If
        Next j
        If Not bChanged Then Range("Z" & r).Value = OrigNum
    Next r
  End With
End Sub

 

[mmmaxmmm]

OK, I was spooked by the HTML Maker screen shot showing "Excel 2012"
A newer version of the HTML Maker is being developed by one of the forum members, see here
Also, when using the HTML Maker, look for options to reduce the number of formulas shown. There is generally no need to display multiple formulas that are basically the same, it just fills up the board and makes your post and the thread hard to read/navigate.

Because I don't have all your columns of data/formulas or the 'New Price List' sheet, I cannot test this code so it is unlikely to work first off, but may point you in the right direction.

I actually think there would be a more direct way to test these numbers without having to physically test them in column Z. However, because of not having all the formulas etc, and also because it is likely too large a job for a free public forum like this, I have gone with the substitution into column Z. That in itself may have problems, depending on the complexity of your workbook. After a value is inserted in col Z, the code may move on too quickly before the sheet has calculated the new value for col AU. The problem would occur where I have marked some asterisks in the code and a bit more might be needed there.

Anyway, see if this does anything (in a copy of your workbook).

I have assumed the 'Detail' sheet is the active sheet when the code is run.

Sub TestNumbers()
  Dim RX As Object, Nums As Object
  Dim data As Variant
  Dim r As Long, j As Long, num As Long, OrigNum As Long
  Dim bChanged As Boolean
  
  Const HdrRow As Long = 6
  
  Set RX = CreateObject("VBScript.RegExp")
  RX.Global = True
  RX.Pattern = "\d+"
  data = Range("AC1", Range("AC" & Rows.Count).End(xlUp)).Value
  With Range("Z1").Resize(UBound(data))
    For r = HdrRow + 1 To UBound(data)
      Set Nums = RX.Execute(data(r, 1))
      OrigNum = Range("Z" & r).Value
        For j = 1 To Nums.Count
          num = Nums.Item(j - 1)
          .Cells(r).Value = num
          '******
          If Abs(Range("AU" & r).Value) <= 0.75 Then
            Range("Z" & r).Interior.ColorIndex = 45
            bChanged = True
            Exit For
          End If
        Next j
        If Not bChanged Then Range("Z" & r).Value = OrigNum
    Next r
  End With
End Sub

WOW, this is truly awesome! I don't know how I can thank you properly but this is amazing and is going to save me SOOOO much time at work. I think it just needs a couple of minor tweaks (I'm hoping they're minor). So one thing it does is, it seems to attempt to change column Z even if the variance in column AU is in between our .75 limit. Sometimes this works out in a good way actually and brings the variance closer to 0% but other times, it goes the opposite direction and takes what WAS a lower variance (such as 18%) and uses one of the numbers in the packaging string to change the variance to 73%...which is still in between our limit but obviously we'd rather keep the 18%. Does that make sense?

Obviously, in an ideal world and if you are able, now that I'm seeing this thing work, I'd rather the logic go something like this:
Try placing each number of the packaging string into column Z. If any of them are closer to 0% than the original value in Z, then replace Z with that number and highlight. If none of them are, leave it the way it was.

If that's NOT possible or you don't have time to figure that out, then the next best option would simply be to skip that row if the value in column AU is between our limit or .75.

Peter, thank you so much, I wish I had your skills and your brain and I think I would rule the world!

 

[Peter_SSs]

Best not to fully quote long posts as it makes the thread harder to read/navigate and just occupies storage space needlessly. If you want to quote, quote small, relevant parts only.

Obviously, in an ideal world and if you are able, now that I'm seeing this thing work, I'd rather the logic go something like this:
Try placing each number of the packaging string into column Z. If any of them are closer to 0% than the original value in Z, then replace Z with that number and highlight. If none of them are, leave it the way it was.

OK, see how this goes. (Still untested here)

Sub TestNumbers()
  Dim RX As Object, Nums As Object
  Dim data As Variant, results As Variant
  Dim rngZ As Range, cellZ As Range, cellAU As Range
  Dim r As Long, j As Long, num As Long
  
  Const HdrRow As Long = 6
  
  Set RX = CreateObject("VBScript.RegExp")
  RX.Global = True
  RX.Pattern = "\d+"
  data = Range("AC" & HdrRow + 1, Range("AC" & Rows.Count).End(xlUp)).Value
  Set rngZ = Range("Z" & HdrRow + 1).Resize(UBound(data))
  ReDim results(1 To UBound(data), 1 To 3)
  Application.ScreenUpdating = False
  For r = 1 To UBound(data)
    Set cellZ = rngZ.Cells(r)
    Set cellAU = Intersect(cellZ.EntireRow, Columns("AU"))
    results(r, 1) = cellZ: results(r, 2) = Abs(cellAU.Value)
    Set Nums = RX.Execute(data(r, 1))
    For j = 1 To Nums.Count
      num = Nums.Item(j - 1)
      cellZ.Value = num
      If Abs(cellAU.Value) < results(r, 2) Then
        results(r, 1) = num: results(r, 2) = cellAU.Value: results(r, 3) = True
      End If
    Next j
  Next r
  With rngZ
    For r = 1 To UBound(results)
      With .Cells(r)
        .Value = results(r, 1)
        If results(r, 3) Then .Interior.ColorIndex = 45
      End With
    Next r
  End With
  Application.ScreenUpdating = True
End Sub

 

[mmmaxmmm]

Peter, this seems to work a little better than the last attempt to be certain. One strange thing, the cells in Z don't highlight anymore when they're changed. In terms of the logic and the process of it, I'd say it works 90% of the time. For some reason, when the variance is currently in bounds, -52% for instance, it goes through each number in the packaging string (which is great) and tries to find a scenario where the variance is lower BUT like I said, about 10% of the time it seems to leave the final number in the packaging string (it's ALWAYS the final number in the packaging string) in column Z which ends up making the variance way higher. Like in that one instance, the variance was initially -52%, it then went through the packing string which was[TABLE="width: 211"]
<tbody>[TR]
[TD="class: xl83, width: 211"]1CA/4BX/1000EA/4000[/TD]
[/TR]
</tbody>[/TABLE]
And left the number 4000 in Z, thereby making the variance -1363%. Do you think this is due to what you mentioned before - the code working too quickly for the spreadsheet? I did use F8 to step through the code though, so I don't know if speed was really the issue. It just seems to decide to leave that last packaging string number in there randomly, instead of reverting it back to the original value in Z. Hope that makes sense...It's still amazing and I already will be able to use this to make things faster, but will have to put in a copy column of Z off to the right so I can go through and put the correct numbers back in Z after the macro runs and messes up that 10%. So thank you for this sir! ...if you have any ideas on how to fix the two issues described above, I would be extremely appreciative.

 

[Peter_SSs]

Very hard to work out the problem without a working set of sample data. If this post doesn't resolve it, are you able to post a working file with a small set of sample data (sensitive information removed or disguised) on a public file-share site (eg DropBox) and post the link to that file here?

Comments
- I can't think why the changed value is not being highlighted.
- Leaving the last string value in Z when it produces a very wrong result - also not sure why. However, if it is doing this when you are stepping through the code with F8, then it isn't the speed of recalculation.

Anyway, here is a slightly modified version to try. To be honest, I think this works the same as the last version (I have just compacted it a little) but worth a try.

Sub TestNumbers_v2()
  Dim RX As Object, Nums As Object
  Dim data As Variant, results(1 To 3) As Variant
  Dim rngZ As Range, cellZ As Range, cellAU As Range
  Dim r As Long, j As Long, num As Long
  
  Const HdrRow As Long = 6
  
  Set RX = CreateObject("VBScript.RegExp")
  RX.Global = True
  RX.Pattern = "\d+"
  data = Range("AC" & HdrRow + 1, Range("AC" & Rows.Count).End(xlUp)).Value
  Set rngZ = Range("Z" & HdrRow + 1).Resize(UBound(data))
  Application.ScreenUpdating = False
  For r = 1 To UBound(data)
    Set cellZ = rngZ.Cells(r)
    Set cellAU = Intersect(cellZ.EntireRow, Columns("AU"))
    results(1) = cellZ: results(2) = Abs(cellAU.Value): results(3) = False
    Set Nums = RX.Execute(data(r, 1))
    For j = 1 To Nums.Count
      num = Nums.Item(j - 1)
      cellZ.Value = num
      If Abs(cellAU.Value) < results(2) Then
        results(1) = num: results(2) = cellAU.Value: results(3) = True
      End If
    Next j
    With rngZ.Cells(r)
      .Value = results(1)
      If results(3) Then .Interior.ColorIndex = 45
    End With
  Next r
  Application.ScreenUpdating = True
End Sub

 

[mmmaxmmm]

Peter you did it man! This thing rocks from start to finish and it's amazing. This is going to save me so much time and effort. I would love to be able to understand how you did this and what the code you wrote does exactly. I will start googling parts of the code and go from there. In any case, thank you thank you thank you.

 

[Peter_SSs]

You are welcome. Glad it ended up working well for you.