Insert a picture from another worksheet

sparky2205

Active Member
Joined
Feb 6, 2013
Messages
350
Office Version
  1. 365
  2. 2016
Platform
  1. Windows
Hi folks,
I've inherited a spreadsheet that now requires changes.
The spreadsheet has a macro to update Pictograms based on a description that is populated earlier in the code.
Currently it is set up to populate the pictograms from a network location. I want to change this so that the pictograms are instead stored within the spreadsheet on a tab called "Pictograms".
Apologies for variable names in advance as the original spreadsheet is German.

What I currently have:
VBA Code:
Set BILD = ActiveSheet.Pictures.Insert(ADRESSE + BEZEICHNUNG + ".png")
BILD is declared as a Picture
ADRESSE is a String to hold the network address
BEZEICHNUNG is a string to hold the picture name (i.e.pictogram name)

What I'm trying to achieve:
VBA Code:
Set BILD = ActiveSheet.Pictures.Insert(Worksheets("Pictograms").shapes(BEZEICHNUNG)

This is in a loop which updates BEZEICHNUNG each time through the loop and inserts the appropriate picture.

This is producing a compile error: Expected: list separator or )
 

GWteB

Well-known Member
Joined
Sep 10, 2010
Messages
2,473
Office Version
  1. 2013
Platform
  1. Windows
I'm on it right now. It appears to be a timing conflict regarding the clipboard. Code errors unexpected and randomly on the red colored line (wks is a reference to the Tabelle2 worksheet, I'll explain later ...).
I'm trying to tackle that by implementing a tiny delayment in milliseconds, will see if thats appropriate ...
Rich (BB code):
                With Sheets("Pictograms")
                    Set shpPictureToCopy = .Shapes(BEZEICHNUNG).Duplicate
                    shpPictureToCopy.Cut
                End With

                wks.Range("H" & ZEILE).PasteSpecial xlPasteAll
 

Excel Facts

Links? Where??
If Excel says you have links but you can't find them, go to Formulas, Name Manager. Look for old links to dead workbooks & delete.

sparky2205

Active Member
Joined
Feb 6, 2013
Messages
350
Office Version
  1. 365
  2. 2016
Platform
  1. Windows
Hmm! Maybe that's related to what I saw earlier.
After one particular time when the code threw an error I happened to notice that I had been left with a duplicate picture in the Pictograms worksheet.
That would suggest that the error happened after the duplicate instruction and at the cut instruction or somewhere around there.
Is there a way to do the copy and paste directly rather than having to duplicate and then cut and paste?
At least then I wouldn't be left with duplicate pictograms in the worksheet if the error happened in the future.
 

sparky2205

Active Member
Joined
Feb 6, 2013
Messages
350
Office Version
  1. 365
  2. 2016
Platform
  1. Windows
GWteB,
I really appreciate all your effort on this. If you have time for a debrief when it's resolved I'd love to hear how you isolated the error. Once the debugging stopped at the calling procedure I was stumped.
I have to signoff now for the evening. My son is playing a match and there'll be hell to pay if I'm late.
I'll be back online in the morning again. Chat then.
 

GWteB

Well-known Member
Joined
Sep 10, 2010
Messages
2,473
Office Version
  1. 2013
Platform
  1. Windows
@sparky2205, I'm confident that your additional problem has been resolved. Some remarks beforehand.
After one particular time when the code threw an error I happened to notice that I had been left with a duplicate picture in the Pictograms worksheet.
That would suggest that the error happened after the duplicate instruction and at the cut instruction or somewhere around there.
My observations showed that VBA kept crashing on the Paste method, but each time at a different time within program flow.
Sometimes after 5 images, other times after 26 images, but never with the first image, hence very strange.

Is there a way to do the copy and paste directly rather than having to duplicate and then cut and paste?
I thought for a while that this could also be a cause, but nothing pointed to that.
Eventually I moved away from the Duplicate method so that the source worksheet can remain protected and hidden.

All attempts to build in a delay (using Windows API functions) of any duration failed. VBA kept throwing a runtime error on the Paste method, and of course again at different times. The conclusion must therefore be that it is some kind of bug in Excel or VBA. I solved this by wrapping the Paste method in a loop. On my 10 years old machine a value of 3 for the maximum amount of consecutive attempts works satisfactorily. You are of course free to increase this value where necessary. To be on the safe side, I've built in an escape option. During my tests this only came up with a value of 1 for the maximum number of attempts, so users will hardly notice that if you set the right value.

The main procedure has been moved to a standard module, where such a procedure is more appropriate than in the code-behind module of a worksheet. By the way, it is no longer declared as Function but as Sub, and it is declared Private, so it cannot be seen in the Macro Dialog (Ribbon > Developers tab > Macros -or- ALT F8).
Because of this move, all used Range objects (cells on your worksheet) had to be explicitly qualified. That was not a big task and is always recommended to avoid unexpected behavior or run-time errors.

I've built a check into the button click event handler, so that a possible collision of code is prevented if that button is clicked several times in quick succession.

Some parts of the code are more dense due to using the functions I provided earlier.

Finally, I modified the worksheet change event handler of Tabelle2 in such a way, that it only executes in its entirety when it is really necessary, namely when cell D1 changes because of a different display language. Every now and then I left some comments in the code for better understanding.


This goes in the worksheet module Tabelle2:
VBA Code:
Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim oWs As Worksheet
    Dim i As Long
    Dim k As String
    Dim r As Long

    ' was the cell with the number of the to be displayed language involved in the worksheet change?
    ' if Yes: proceed to next line
    ' if No:  jump over to End If
    If Not Application.Intersect(Target, Me.Range("D1")) Is Nothing Then

        i = Me.Range("D1").Value
        Set oWs = ThisWorkbook.Worksheets("Languages")
        r = oWs.Cells(oWs.Rows.Count, "A").End(xlUp).Row
        With Application
            k = .WorksheetFunction.Index(oWs.Range("Button"), .Match(i, oWs.Range("Index"), 0))
        End With
        Me.Shapes("Button 1").TextFrame.Characters.TEXT = k
    End If
End Sub

This goes in a standard module:
VBA Code:
Option Explicit

Private IsRunning As Boolean

Public Sub Schaltfläche10_Klicken() 'BUTTON10CLICK

    If Not IsRunning Then
        IsRunning = True
        GEFAHRSTOFFSYMBOL   'TABLE1.HAZARDOUS SUBSTANCE SYMBOL --- CALL THE FUNCTION IN Tabelle1
        IsRunning = False
    End If
End Sub

Private Sub GEFAHRSTOFFSYMBOL()                  ' hazardous substance symbol

    Dim ZEILE           As Long                  'ROW
    Dim ZEILE_ANFANG    As Long                  'LINE_START
    Dim ZEILE_ENDE      As Long                  'LINE_END
    Dim Next_Row_H      As Long                  'Last used row in column H
    Dim COLUMN          As Long
    Dim FIRST_COLUMN    As Long
    Dim LAST_COLUMN     As Long
    Dim FELD            As Long                  'FIELD
    Dim ZAEHLER         As Long                  'COUNTER
    Dim HOEHE           As Single                'HEIGHT
      
    Dim BRENNBAR        As Boolean               'FLAMMABLE
    Dim EXPLOSIV        As Boolean               'EXPLOSIVE
    Dim AETZEND         As Boolean               'CORRISIVE
    Dim GIFTIG          As Boolean               'POISONOUS
    Dim GESUNDHEITSSCHAEDLICH As Boolean         'HARMFUL

    Dim GHS1        As String
    Dim GHS2        As String
    Dim GHS3        As String
    Dim GHS4        As String
    Dim GHS5        As String
    Dim GHS6        As String
    Dim GHS7        As String
    Dim GHS8        As String
    Dim GHS9        As String
    Dim TEXT        As String
    Dim BEZEICHNUNG As String                    'DESCRIPTION
    Dim GHS_NUMMERN As String                    'GHS_NUMBERS
    Dim GHS_SYMBOLE As String                    'GHS_SYMBOL

    'Hier kommt der Definitionsteil, in dem alle Parameter eingestellt werden
    'Here comes the definition part, in which all parameters are set
    '************************************************************************

    ZEILE_ANFANG = 5                             'Ab welcher Zele sollen die GHS-Symbole eingesetzt werden --- From which row should the GHS symbols be used
    FIRST_COLUMN = 10                            'First column containing a H number
    LAST_COLUMN = 17                             'Last column containing a H number
    GHS_NUMMERN = "I"                            'In welche Spalte sollen die GHS-Nummern eingefügt werden --- In which column should the GHS numbers be inserted
    HOEHE = 29                                   'Wie hoch sollen die GHS-Symbole sein --- How high should the GHS symbols be
    GHS_SYMBOLE = "H"                            'In welche Spalte sollen die GHS-Symbole eingesetzt werden --- In which column should the GHS symbols be placed
    '************************************************************************
    'Hier endet der Definitionsteil, in dem alle Parameter eingestellt werden
    'This is where the definition section ends, in which all parameters are set

    'Folgende Ausschlussbedingungen gibt es:
    'There are the following exclusion conditions:
    '************************************************************************
      
    'a) Wenn GHS01 dann kein GHS02 und GHS03 --- IF GHS01 THEN NO GHS02 AND GHS03
    'b) Wenn GHS06 dann kein GHS07 --- IF GHS06 THEN NO GHS07
    'c) Wenn GHS05 und H315 oder H319 dann kein GHS07 --- IF GHS05 AND H315 OR H319 THEN NO GHS07
    'd) WENN GHS08 und H315 oder H317 oder H319 dann kein GHS07 --- IF GHS08 AND H315 OR H317 OR H319 THEN NO GHS07
    'e) Wenn GHS02 oder GHS06 dann kein GHS04 --- IF GHS02 OR GHS06 THEN NO GHS04
      
    '************************************************************************
    'Hier endet die Beschreibung der Ausschlussbedingungen
    'The description of the exclusion conditions ends here


    Application.ScreenUpdating = False
    Application.EnableEvents = False
      
    ' GWteB
    ' explicit declaration recommended
    Dim oWs     As Worksheet
    Dim ActCell As Range

    For Each oWs In ThisWorkbook.Worksheets      'Folgende Routine setzt alle Filterungen zurück, da sonst das Programm nicht richtig funktioniert --- The following routine removes all filters, otherwise the program will not work properly
        With oWs
            If .FilterMode Then .ShowAllData
        End With
    Next oWs
    
    ' GWteB
    ' set a proper reference to destination worksheet with name Tabelle2 (reference can and will be reused)
    Set oWs = ThisWorkbook.Worksheets("Tabelle2")
    
    ' GWteB
    ' proceed if te intended sheet is also the current displayed sheet, otherwise jump to corresponding End If
    If ActiveSheet.Parent.Name = oWs.Parent.Name And ActiveSheet.Name = oWs.Name Then
    
        ' GWteB
        ' store ActiveCell (and restore it afterwards) so none of the inserted pictures stays selected when we're finished
        Set ActCell = ActiveCell
    
        ' GWteB
        ' multiple use of the worksheet reference named oWs on next few lines
        ZEILE_ENDE = oWs.Cells(oWs.Rows.Count, "A").End(xlUp).Row 'Bis zu welcher Zele sollen die GHS-Symbole eingesetzt werden --- Up to which line should the GHS symbols be used (Get the last used row)
    
    
        oWs.Pictures.Delete                      'Bei jedem Programmaufruf werden alle Bilder erst einmal gelöscht, sonst würden immer mehr Bilder übereinander abgelegt --- Each time the program is called, all images are first deleted, otherwise more and more images would be stored on top of each other
        oWs.Range("I5:I" & ZEILE_ENDE).ClearContents
      
        oWs.Columns(GHS_SYMBOLE).ColumnWidth = HOEHE 'HEIGHT
      
        For ZEILE = ZEILE_ANFANG To ZEILE_ENDE   'FOR ROW = ROW_START TO ROW_END
      
            For COLUMN = FIRST_COLUMN To LAST_COLUMN
                  
                GHS1 = ""
                GHS2 = ""
                GHS3 = ""
                GHS4 = ""
                GHS5 = ""
                GHS6 = ""
                GHS7 = ""
                GHS8 = ""
                GHS9 = ""
      
                TEXT = oWs.Cells(ZEILE, COLUMN).Value
                        
                ' GWteB
                ' if variable TEXT doesn't contain a string (so it's length equals zero) there would be nothing to compare against
                ' in that case:         do nothing, jump to corresponding End If;
                ' in any other case:    proceed with next line

                    If Len(TEXT) > 0 Then

                        BRENNBAR = False         ' FLAMMABLE
                        EXPLOSIV = False         ' EXPLOSIVE
                        AETZEND = False          ' CORROSIVE
                        GIFTIG = False           ' POISONOUS
                        GESUNDHEITSSCHAEDLICH = False ' HARMFUL
            
            
                        If StringContainsAny(TEXT, Array(200, 201, 202, 203, 204, 240, 241)) Then
                            GHS1 = "Picture 1, "
                            EXPLOSIV = True
                        End If

                        If EXPLOSIV = False Then
                            If StringContainsAny(TEXT, Array(220, 222, 223, 224, 225, 228, 241, 242, 250, 252, 260, 261)) Then
                                GHS2 = "Picture 2, "
                                BRENNBAR = True  ' FLAMMABLE
                            End If
                            If StringContainsAny(TEXT, Array(226, 251)) Then
                                GHS2 = "Picture 2, "
                            End If
                            If StringContainsAny(TEXT, Array(270, 271, 272)) Then
                                GHS3 = "Picture 3, "
                            End If
                        End If

                        If StringContainsAny(TEXT, Array(300, 301, 310, 311, 330, 331)) Then
                            GHS6 = "Picture 6, "
                            GIFTIG = True        ' POISONOUS
                        End If

                        If BRENNBAR = False Then
                            If GIFTIG = False Then
                                If StringContainsAny(TEXT, Array(280, 281)) Then
                                    GHS4 = "Picture 4, "
                                End If
                            End If
                        End If

                        If StringContainsAny(TEXT, Array(334)) Then
                            GHS8 = "Picture 8, "
                            GESUNDHEITSSCHAEDLICH = True ' HARMFUL
                        End If

                        If StringContainsAny(TEXT, Array(290, 314, 318)) Then
                            GHS5 = "Picture 5, "
                            AETZEND = True       ' CORROSIVE
                        End If

                        If StringContainsAny(TEXT, Array(304, 340, 341, 350, 351, 360, 361, 370, 371, 372, 373)) Then
                            GHS8 = "Picture 8, "
                        End If

                        If GIFTIG = False Then
                            If StringContainsAny(TEXT, Array(302, 312, 332)) Then
                                GHS7 = "Picture 7, "
                            End If

                            If AETZEND = False Then
                                If GESUNDHEITSSCHAEDLICH = False Then
                                    If StringContainsAny(TEXT, Array(315, 319)) Then
                                        GHS7 = "Picture 7, "
                                    End If
                                End If
                            End If
                  
                            If GESUNDHEITSSCHAEDLICH = False Then
                                If StringContainsAny(TEXT, Array(317)) Then
                                    GHS7 = "Picture 7, "
                                End If
                            End If

                            If StringContainsAny(TEXT, Array(335, 336, 420)) Then
                                GHS7 = "Picture 7, "
                            End If
                        End If

                        If StringContainsAny(TEXT, Array(400, 410, 411)) Then
                            GHS9 = "Picture 9, "
                        End If

                        ' GWteB
                        ' yet another use of worksheet reference oWs

                        oWs.Range(GHS_NUMMERN & ZEILE) = oWs.Range(GHS_NUMMERN & ZEILE) & GHS1 & GHS2 & GHS3 & GHS4 & GHS5 & GHS6 & GHS7 & GHS8 & GHS9 ' GHS_NUMBERS & ROW)
            
                    End If
                Next COLUMN
            Next ZEILE


            For ZEILE = ZEILE_ANFANG To ZEILE_ENDE 'Jede Zeile wird überprüft --- Every line is checked

                ' GWteB
                ' yet another use of worksheet reference oWs
        
                TEXT = oWs.Range(GHS_NUMMERN & ZEILE)
                ZAEHLER = 0

                For FELD = 1 To 9                'Jedes Gefahrensymbol wird gesucht --- Every danger symbol is searched for

                    BEZEICHNUNG = "Picture " & CStr(FELD) '"GHS0?" ' DESCRIPTION

                    If InStr(TEXT, BEZEICHNUNG) Then

                        ThisWorkbook.Worksheets("Pictograms").Shapes(BEZEICHNUNG).Copy

                        Dim shpJustPasted   As Picture
                        Dim ErrorNumber     As Long
                        Dim MaxAttempts     As Long
                        Dim Attempts        As Long
                        Dim MsgAnswer       As VbMsgBoxResult

                        ' ------------------------------------------------------------------------
                        ' GWteB: Prevent some mysterious, not consistent behavior:
                        '        VBA randomly throws a run-time error on the Worksheet.Paste method

SUB_Retry:
                        MaxAttempts = 3        ' <<<<<  change maximum amount of attempts to suit
                        Attempts = 0
                        ErrorNumber = -1
                        MsgAnswer = vbOK

                        Do Until Attempts = MaxAttempts
                            On Error Resume Next
                            oWs.Paste oWs.Range(GHS_SYMBOLE & ZEILE)
                            ErrorNumber = Err.Number
                            Err.Clear
                            On Error GoTo 0
                            If Not CBool(ErrorNumber) Then
                                Exit Do
                            Else
                                Attempts = Attempts + 1
                            End If
                        Loop
                        If CBool(ErrorNumber) Then
                            MsgAnswer = MsgBox("Error on pasting pictures, maximum amount of attempts has been reached.", vbExclamation + vbRetryCancel, "Gefahrstoffsymbol")
                        End If
                        If MsgAnswer = vbRetry Then GoTo SUB_Retry
                        If MsgAnswer = vbCancel Then GoTo SUB_Cancel
                        ' -------------------------------------------------------------------------

                        Set shpJustPasted = oWs.Pictures(oWs.Pictures.Count)

                        With shpJustPasted
                            .Name = BEZEICHNUNG
                            .Locked = False
                            .ShapeRange.LockAspectRatio = msoFalse
                            .Height = HOEHE
                            .Width = HOEHE
                            .Top = oWs.Range(GHS_SYMBOLE & ZEILE).Top + 1
                            .Left = oWs.Range(GHS_SYMBOLE & ZEILE).Left + ZAEHLER + 1 ' COUNTER
                            .Placement = xlMove
                        End With

                        ZAEHLER = ZAEHLER + HOEHE

                    End If
                Next
            Next

            oWs.Range(GHS_SYMBOLE & ZEILE_ANFANG & ":" & GHS_SYMBOLE & ZEILE_ENDE).Rows.EntireRow.AutoFit

SUB_Cancel:
            ' GWteB
            ' reposition Excel's selector where it initial came from
            ActCell.Activate
    
        End If
    
        Application.ScreenUpdating = True
        Application.EnableEvents = True
      
    End Sub


Public Function StringContainsAny(ByVal argLookIn As String, ByRef argSearchFor As Variant) As Boolean
    Dim i As Long, s As String
    If argLookIn <> vbNullString Then
        If VarType(argSearchFor) And vbArray Then
            ' only one dimensional arrays supported
            For i = LBound(argSearchFor) To UBound(argSearchFor)
                On Error Resume Next
                s = CStr(argSearchFor(i))
                On Error GoTo 0
                If StringContains(argLookIn, s) Then
                    StringContainsAny = True
                    Exit For
                End If
            Next i
        Else
            On Error Resume Next
            s = CStr(argSearchFor)
            On Error GoTo 0
            StringContainsAny = StringContains(argLookIn, s)
        End If
    End If
End Function

Public Function StringContains(ByVal argLookIn As String, ByVal argSearchFor As String, Optional ByVal argCaseSensitive As Boolean = False) As Boolean
    Dim CompMethod As VbCompareMethod
    If argCaseSensitive Then
        CompMethod = vbBinaryCompare
    Else
        CompMethod = vbTextCompare
    End If
    StringContains = (Len(argSearchFor) > 0) And CBool(InStr(1, CStr(argLookIn), CStr(argSearchFor), CompMethod))
End Function
 

Alex Blakenburg

Well-known Member
Joined
Feb 23, 2021
Messages
2,298
Office Version
  1. 365
Platform
  1. Windows

ADVERTISEMENT

Glad @GWteB has done the hard part. I couldn't reproduce the picture pasting anomalies.

A couple of other suggestions.
1) I noticed that in Column I that if a Picture was relevant to more than one column it repeated the Text in column I.
I suspect that you don't want this.
So move the resetting of the GHS% = "" from the Inner Column Loop to the Outer Row loop AND the output statement at the bottom as well eg:

Initialise when the code moves to the next row
VBA Code:
      For ZEILE = ZEILE_ANFANG To ZEILE_ENDE 'FOR ROW = ROW_START TO ROW_END
    
        ' XXX Moved from Column Loop to outer Row Loop XXX
          GHS1 = ""
          GHS2 = ""
          GHS3 = ""
          GHS4 = ""
          GHS5 = ""
          GHS6 = ""
          GHS7 = ""
          GHS8 = ""
          GHS9 = ""
     
            For COLUMN = FIRST_COLUMN To LAST_COLUMN

Output value just before the code moves to the next row
VBA Code:
                 Next i
                           
            Next COLUMN
      
        ' XXX Moved from Column Loop to outer Row Loop XXX
        Range(GHS_NUMMERN & ZEILE) = Range(GHS_NUMMERN & ZEILE) + GHS1 + GHS2 + GHS3 + GHS4 + GHS5 + GHS6 + GHS7 + GHS8 + GHS9 ' GHS_NUMBERS & ROW)
    
        Next ZEILE

2) Options for associating H Phrases with Pictures
a) Have a table in the workbook with the codes and matching Picture numbers

b) Change from looping through value arrays to Select Case
eg
VBA Code:
Sub TestSelectCase()

    Dim TEXT As String
  
    TEXT = "H318"
    TEXT = Right(TEXT, 3)
  
    Select Case TEXT
  
        Case 310, 318, 320
            MsgBox "Found value"
      
        Case Else
            MsgBox "NOT FOUND"
      
    End Select
  
End Sub
 

sparky2205

Active Member
Joined
Feb 6, 2013
Messages
350
Office Version
  1. 365
  2. 2016
Platform
  1. Windows
Hi guys,
Wow! I think you could call that a complete resign from what I initially started with.
First things first, it's running as sweetly as I could have hoped for. Consistently correct results now.
I just have to populate more of the H numbers in the rest of the sheet and make sure everything is still running smoothly. No doubt it will.
@GWteB: I used your new code. There's a lot going on there and I need to take some time to understand it fully, but it works so happy days.
@Alex: I used your first suggestion to prevent repeats in Column I. Much cleaner looking now.
Your second suggestion is intriguing. I presume the idea behind this is to replace the Case 310, 318, 320 with something like Case Picture1 where Picture1 is a named range referencing all the H numbers related to Picture1? There are a few exclusion conditions which might make that a bit tricky but the advantage being that it would be much easier to update the workbook for new H phrases. The user could do it.
 

Alex Blakenburg

Well-known Member
Joined
Feb 23, 2021
Messages
2,298
Office Version
  1. 365
Platform
  1. Windows

ADVERTISEMENT

In my 2nd suggestion using a table it the cleanest for future maintenance, since you don't need to modify the code.

The Select Case method means you don't have to loop through each array of values, which should be much more efficient.

Yes in both cases you probably use it to determine the picture and then work in the additional conditions.
I didn't see any conditions that didn't involve using the H Phrase as the main include or exclude.
 

GWteB

Well-known Member
Joined
Sep 10, 2010
Messages
2,473
Office Version
  1. 2013
Platform
  1. Windows
Wow! I think you could call that a complete resign from what I initially started with.
That is, on a limited scale. As @Alex Blakenburg pointed out, there's much more room for improvement.

In a previous stage we had no insight into the data you were working with. Because of a frequent duplication of code usage, the lack of clarity and the method already used (text-oriented), the array comparison came into view. With the knowledge of the contents of your worksheet I agree with Alex's suggestion to organize the branches numerically so that the Select Case construct can be used. At one point this also crossed my mind since I'm a proponent of avoiding redundant code (especially if executed in a loop), but the ghostly, unpredictably recurring run-time error was my first concern.

Regarding the suggested Select Case construct and for a better understanding, it might be a good idea to familiarize yourself with the difference between implicit and explicit use of variables and the different data types that VBA provides. You might want to take a look over here and over here ...
 

sparky2205

Active Member
Joined
Feb 6, 2013
Messages
350
Office Version
  1. 365
  2. 2016
Platform
  1. Windows
I've been having a look through GWteB's code and to be honest I'm a bit bamboozled by it.
I'm not anywhere near at the same level as you guys at this stuff and this looks beyond my ability to understand. The extra functions StringContainsAny and StringContains in particular. These appear very complex compared to the previous code. I presume they are doing the actual checking of TEXT against the members of the array but what exactly is going on there o_O.
This would make it quite difficult for me to change arrays and loops into Select Cases.
And I certainly don't want to disrupt anything with @GWteB's code that has solved my initial problem.
With that in mind I attempted to do it the simplest way I could come up with and change the arrays so they reference a table.

So I created a table called Table3. I also renamed it PicTable1. I also created a named range Picture_1 for the data in the table.
I then altered this line:
If StringContainsAny(TEXT, Array(200, 201, 202, 203, 204, 240, 241)) Then
to
If StringContainsAny(TEXT, Array(Worksheets("H-phrases").ListObjects("Table3").DataBodyRange.Value)) Then

This runs fine for the originally created table but if I add a value to the table it is not picked up when I run the program.
The program runs and inserts all the other pictograms as usual but doesn't include the new pictogram for the newly inserted H phrase in Tabelle2.
If I run the original line of code and insert the new H phrase directly i.e. If StringContainsAny(TEXT, Array(200, 201, 202, 203, 204, 240, 241,500)) Then
the new pictogram is inserted fine. So there's obviously something wrong with the way I've inserted the table reference into the array.

Also I tried to use the renamed table name PicTable1 and my named range Picture1 but I got a Subscript out of range error. I double and triple checked and the spelling is correct.
Not sure what's going on there.
 

sparky2205

Active Member
Joined
Feb 6, 2013
Messages
350
Office Version
  1. 365
  2. 2016
Platform
  1. Windows
By the way guys all this is extra, over and above my original query, which has been solved. And again thanks very much for that.
This is just to make maintenance much easier and it won't have to come back to me to be done. Anybody could do it.
I still hold out hope of a lottery win and early retirement :rolleyes:. Ever the optimist.
So as I've already taken so much of your time and you have helped me so much I understand if you feel it's time to walk away from this one with a casual "my work here is done".
 

Forum statistics

Threads
1,148,340
Messages
5,746,186
Members
423,998
Latest member
eakenila

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top