2

From a multiple column range I want to in one procedure create a one dimensional array by splitting each cell value (if needed) in multiple strings?, convert? to integers. Values will be delimited by a specific character, also it has to ignore other characters

This... ..would result in 1, 2, 3, 4, 7, 9, 11, 13, 54, 67

The code I'm working with now:

Private Sub Worksheet_Change(ByVal Target As Range)
Application.ScreenUpdating = False

Dim arr As Variant
arr = Range("A1:A" & Range("A" & Rows.Count).End(xlUp).Row).Value   'Convert to 2-dim and use non numerical values from adjacent column, see "Excha.."

Dim varr As Variant
varr = Range("C1:E" & Range("A" & Rows.Count).End(xlUp).Row).Value  'Split if some of the cells contains multiple values delimited by character??

Dim M As Integer
M = Application.WorksheetFunction.Max(r.Offset(, 2))                'Exchange cell ref to Max(len("x2"

TextBox1.Text = ""

Dim x, y, match As Boolean, i As Integer, L As Integer

i = 1

For Each x In arr
    match = False
    For Each y In varr
        If x = y Then
            match = True
            Exit For
        End If
    Next y
    If Not match And Len(x) <> "" Then
        If i = 1 Then
            TextBox1.Text = x & ". " & Worksheets(1).Cells(x, 2).Value                                  'Exchange cell ref to "x2"
        Else
            TextBox1.Text = TextBox1.Text & String(L, " ") & x & ". " & Worksheets(1).Cells(x, 2).Value 'Exchange cell ref to "x2"
        End If
        L = M + 5 - (Len(Worksheets(1).Cells(x, 1).Value) + Len(Worksheets(1).Cells(x, 2).Value))       'Exchange cell ref to len(x)& len("x2")
    End If
        i = i + 1
    End If
Next

Application.ScreenUpdating = True
End Sub
braX
  • 11,506
  • 5
  • 20
  • 33
mrkrister
  • 67
  • 1
  • 6
  • Can you explain shortly where your code fails? What is the issue? Once you explain that we will be able to help – Pierre44 Oct 18 '18 at 13:31
  • Why is this a Worksheet_Change? –  Oct 18 '18 at 13:33
  • Do you actually mean 1 single comma separated string containing all the numeric values from the range ? If that is the case I would consider regex. – QHarr Oct 18 '18 at 13:41
  • @Pierre44 Sorry the code works with cells containing an integer only, posted it for context – mrkrister Oct 18 '18 at 13:43
  • @Jeeped It constantly updates a textbox with available resources – mrkrister Oct 18 '18 at 13:46
  • @QHarr Rather an array containing those values that I can test similarly to what I have now – mrkrister Oct 18 '18 at 14:08
  • That is fine as you can use Split on the string to generate the array as shown in given answer. – QHarr Oct 18 '18 at 14:09
  • @QHarr Alright! Don't really know if my original method is efficient and the result will probably be next to unreadable :P but i'll try to implement that and see what happens – mrkrister Oct 18 '18 at 14:16
  • @QHarr Not sure how to approach this, asked the same question below.. These two does't seem to be comparable `varr = ExtractNumbers(Range(nm.Name))` & `arr = r.Value` any ideas ? Both are dimmed as Variants – mrkrister Oct 23 '18 at 09:15

1 Answers1

1

You could do this easily with a Regular Expression

Option Explicit

Sub TestExtract()
    Dim Arr As Variant
    Arr = ExtractNumbers(Worksheets("Sheet1").Range("A1:F10")) 'specify which range to analyze

    Debug.Print Join(Arr, "; ") 'just to visualize the array
End Sub

Public Function ExtractNumbers(Target As Range) As Variant
    Dim regEx As Object
    Set regEx = CreateObject("vbscript.regexp")

    Dim regExMatches As Object, regExMatch As Object
    Dim Result As String

    Dim Cell As Range
    For Each Cell In Target 'loop through each cell
        If Cell.Value <> vbNullString Then
            With regEx
                .Global = True
                .MultiLine = True
                .IgnoreCase = False
                .Pattern = "[0-9]+"
            End With

            'find all integers in each cell
            Set regExMatches = regEx.Execute(Cell.Value)
            For Each regExMatch In regExMatches
                Result = Result & regExMatch & ";"
            Next regExMatch
        End If
    Next Cell

    ExtractNumbers = Split(Left$(Result, Len(Result) - 1), ";") 'convert into array
    'sort array here if needed
End Function

Note that I didn't show the array sort because there are 1 million tutorials for that already.

Pᴇʜ
  • 56,719
  • 10
  • 49
  • 73
  • Thank you! Not so familiar with this :) n itself it works perfectly and I will try to implement it in my code somehow. Since there is a million tutorials do you happen to know one applicable to this and also how can I avoid duplicate values in this – mrkrister Oct 18 '18 at 15:06
  • [Sort Array](https://stackoverflow.com/questions/152319/vba-array-sort-function) and [Remove Duplicates from Array](https://stackoverflow.com/questions/15877273/vba-removing-duplicates-values-in-an-array-including-the-same-value) should help you. – Pᴇʜ Oct 18 '18 at 15:13
  • Haha, alright! Thought there would be like a "If Not .exists()"-way to add in a loop and something like ".Sort". But thanks! This will keep me occupied for a while :) – mrkrister Oct 18 '18 at 15:39
  • These two does't seem to be comparable `varr = ExtractNumbers(Range(nm.Name))` & `arr = r.Value` any ideas ? Both are dimmed as Variants – mrkrister Oct 23 '18 at 09:12
  • While `ExtractNumbers` returns a one dimensional array `r.Value` returns a two dimensional array (if `r` is of type `range`). That's why they are different. – Pᴇʜ Oct 23 '18 at 09:51
  • It looks like this `Set r = Worksheets(1).Range("A1:A" & Worksheets(1).Range("A" & Rows.Count).End(xlUp).Row)` – mrkrister Oct 23 '18 at 10:08
  • If x = y doesn't result in any matches even if I apply an integer(same) in the first cell of each range – mrkrister Oct 23 '18 at 11:54
  • 1
    OK I cannot clarify that in a comment. Your question was *"Create one dimensional array by splitting each cell value in multiple integers delimited by a character, ignoring other characters"* and the function `ExtractNumbers` does return a one dimensional array of all integers in the given range. If you have a new question now then please ask a new question and show your actual code there. New questions cannot be answered in comments. – Pᴇʜ Oct 23 '18 at 12:11
  • I posted a new question including your contribution, should I tag you somehow ? – mrkrister Oct 23 '18 at 14:15