[VBA] If a Cell contains one range run routine once with 1 range, otherwise 2 times for 2 times?

[NessPJ]

Hello there,

I have the following code in my project.
The value ArtikelLabel can contain: $T$3:$AC$26 (single value) but also: $T$3:$AC$26, $T$30:$AC$53 (multiple values).
How can i adjust my code so when 1 value is present the routine runs for the 1 value and if 2 (or 3) values are present it will run for every value that is present in the Cell?

Sub Print()

Dim ArtikelNrLabel As String, ArtikelNrAdres As String, ArtikelLabel As String

Foundvalue = Find("15", "Masterdata", "B")                    'This searchstring is normally user input

ArtikelNrLabel = Sheets("Masterdata").Range(Foundvalue).Offset(0, 5).Value
ArtikelNrAdres = Find(ArtikelNrLabel, "Parameters", "M")

ArtikelLabel = Sheets("Parameters").Range(ArtikelNrAdres).Offset(0, 3).Value         '<<< Question is about this value

    With Sheets("Masterdata").PageSetup
    .PrintArea = ArtikelLabel                                                '<<< Question is about this value

    .Zoom = False
    .LeftMargin = Application.InchesToPoints(0.4)
    .RightMargin = Application.InchesToPoints(0.1)
    .TopMargin = Application.InchesToPoints(0.4)
    .BottomMargin = Application.InchesToPoints(0.1)
    .HeaderMargin = Application.InchesToPoints(0.1)
    .FooterMargin = Application.InchesToPoints(0.1)
    .CenterHorizontally = False
    .CenterVertically = False
    .Orientation = xlLandscape
    End With

Sheets("Masterdata").PrintOut Copies:=Aantal, Collate:=True, _
       IgnorePrintAreas:=False, ActivePrinter:=Printer                                                'Labels printen


Private Function Find(Searchstring As String, SearchSheet As String, SearchColumn As String)

    'Dim FoundSomething As Range
    Dim SearchValueFUNC As Range, SearchRange As Range, Found As String
    Dim SearchResult As String

    Set SearchRange = Sheets(SearchSheet).Columns(SearchColumn)
    Set SearchValueFUNC = SearchRange.Cells.Find(what:=Searchstring, LookAt:=xlWhole)
    If (Not SearchValueFUNC Is Nothing) Then
    Find = SearchValueFUNC.Address
    Else
    Find = vbNullString
    End If

End Function

 

[NessPJ]

Anyone?


PS. Topic title should be:
[VBA] If a Cell contains one range run routine once with 1 range, otherwise 2 times for 2 ranges?

 

[NessPJ]

I found the solution myself in the meantime. Posting it here if anyone else ever needs it.

I ended up using the VBA SPLIT function to read multiple values from a Cell (the delimiter can be configured as you please, i use a ";" semicolon).
The Split function gives you an Array. Then i use a Variable to store the size of the Array.
Lastly i use a "For ... to ... Step 1" Loop which uses the variable for the Array size to loop through the selection of the Routine as many times as needed.

Dim ArtikelNrLabel As String, ArtikelNrAdres As String, ArtikelLabel As String, ArtikelLabels() As String
Dim ArrayNummer As Integer

Foundvalue = Find("15", "Masterdata", "B")                    'This searchstring is normally user input

ArtikelNrLabel = Sheets("Masterdata").Range(Foundvalue).Offset(0, 5).Value
ArtikelNrAdres = Find(ArtikelNrLabel, "Parameters", "M")


ArtikelLabel = Sheets("Parameters").Range(ArtikelNrAdres).Offset(0, 3).Value                 '<<<<< The topic was about this value in my case

ArtikelLabels() = Split(ArtikelLabel, ";")                                   

ArrayNummer = UBound(ArtikelLabels)                                      'Reminder: Arrays derived from a Split function start at 0!

For ArrayNummer = 0 To ArrayNummer Step 1                          'For Loop


    'De Pagina instellingen worden opgegeven
    With Sheets("Masterdata").PageSetup
    .PrintArea = ArtikelLabels(ArrayNummer)                              'This is where the Array Variable goes in my situation for every loop
    .Zoom = False
    .LeftMargin = Application.InchesToPoints(0.4)
    .RightMargin = Application.InchesToPoints(0.1)
    .TopMargin = Application.InchesToPoints(0.4)
    .BottomMargin = Application.InchesToPoints(0.1)
    .HeaderMargin = Application.InchesToPoints(0.1)
    .FooterMargin = Application.InchesToPoints(0.1)
    .CenterHorizontally = False
    .CenterVertically = False
    .Orientation = xlLandscape
    End With

Sheets("Masterdata").PrintOut Copies:=Aantal, Collate:=True, _
       IgnorePrintAreas:=False, ActivePrinter:=Printer                                                'Labels printen


Next ArrayNummer                                                                                   'Next for For Loop


Private Function Find(Searchstring As String, SearchSheet As String, SearchColumn As String)

    'Dim FoundSomething As Range
    Dim SearchValueFUNC As Range, SearchRange As Range, Found As String
    Dim SearchResult As String

    Set SearchRange = Sheets(SearchSheet).Columns(SearchColumn)
    Set SearchValueFUNC = SearchRange.Cells.Find(what:=Searchstring, LookAt:=xlWhole)
    If (Not SearchValueFUNC Is Nothing) Then
    Find = SearchValueFUNC.Address
    Else
    Find = vbNullString
    End If

End Function