VBA Project - Asset Labels - Code structure and optimization assistance, please :)

JPresbrey

New Member
Joined
Jan 28, 2015
Messages
6
(Spoiler, long post)

Hello all,

I am relatively uneducated when it comes to VBA, but I have muddled my way into a semi-functioning project that until recently worked fine. Let me begin with a little background. I work in Security and we moved to a different Asset Tracking system a little bit ago. Unfortunately, this system did not really provide us with tags that were comparable to the ones we were using, and as such we had decided to make our own style.

I came up with a template based on the design of our old tags in Excel. The original template required the user to copy and paste each tag style (as different assets are color coded) and then manually enter the pertinent information. As you can imagine, this was time consuming and inefficient. So I decided to try to automate as much of the tag generation as possible. I had dabbled a little in VBA (Several of our regularly used forms are in excel, and we have incorporated some simple macros to make them more user friendly) but had never really done any big projects.

To start off I searched the internet to find snippets of code that would do some of what I was looking for. I posted on the Microsoft forums asking about VBA being able to incorporate images from a file (The code I was given in response has worked great for the most part, but sometimes...). I have pretty much frankensteined this project together with various snippets of VBA and use of the record function. The code has changed since I started, and with that come new problems.

The template I have created is supposed to be split into three parts: Mobile Assets, Fixed Assets, and a simple form that I can use to print off just barcodes. This brings me to the first major issue that I’ve been having lately. I seem to only be able to have so many barcode images. I.E. When I reach the limit, and then add a new one, one of the prior barcodes disappears. This has stumped me, and forced me to leave out the simple tag sheet until I can figure it out. However, this issue is also showing up in my other sheets. I think I somehow fixed my mobile sheet, but the fixed sheet was always losing the last tag on the top row, or the first tag on the second row. After about a month of trying to figure it out I decided to redo the VBA code. This was also prompted by a need to use named ranges for ease of troubleshooting (I.E. Fix one tag’s worth of code, copy it with a different range ID, and move on).

At this point I have redone the code, but I am running into a far more irritating problem. Some of the formulas that are called (VLOOKUP) are not actually working, and the cell ranges are not staying unlocked. This is an issue, as I have only 8 cell ranges unlocked, so the formulas aren’t inadvertently erased or altered. I can’t seem to find out what the problem is for either issue, and so I’ve turned to this forum, before I start implanting my head into my desk. To be perfectly honest, I’m also under a potential deadline, in which I pass the template to my supervisor for use, and show him how to use it.

My questions are as follows:
1) First and foremost, can anybody help identify the problem that is preventing my formulas from working?
2) Same with the issue of the cells being locked. This is defeating the purpose of having the sheet protected.
3) Next, I’d really like to know if the issue of limited images (barcodes) can be identified so I can fix it.
4) My final request is about optimization. I’ve tried what I can to squish, condense, and otherwise shortcut it, but again, I’m not really experienced at VBA. Any more tips, tricks, and such would be appreciated J
Sort of tying in to the optimization help, does anyone know if it’s ok to use the Application.Run “blah” to call private code in a different module, or if there’s a better method?

Below is a link to my dummy file (edited to reduce database size and remove some company info) I'm providing the file, as there are several relatively large chunks of code, and it's easier to see it as it's supposed to be.

https://drive.google.com/file/d/0Byf55gi6jLW1UmV1RmpjdWRHWUU/view?usp=sharing


If I’ve missed anything, I apologize. I’ve tried to get this done on my own, and an banging my head against a wall now.
 

Excel Facts

How to total the visible cells?
From the first blank cell below a filtered data set, press Alt+=. Instead of SUM, you will get SUBTOTAL(9,)
This is the Setup code for the Fixed sheet. (This is in a single module with all the other Fixed tag code, excepting the barcode generation code)

Code:
Private Sub Fixed_Setup()On Error Resume Next
    Application.ScreenUpdating = False
    Application.DisplayStatusBar = False
    Application.Calculation = xlCalculationManual
    Application.EnableEvents = False
    Application.PrintCommunication = False
    ActiveSheet.Unprotect
'Basic Page Layout and Formatting
        Columns("A:A").ColumnWidth = 1.71
        Columns("B:B").ColumnWidth = 9
        Columns("C:C").ColumnWidth = 17.57
        Columns("D:D").ColumnWidth = 2.86
        Columns("E:E").ColumnWidth = 9
        Columns("F:F").ColumnWidth = 17.57
        Columns("G:G").ColumnWidth = 2.86
        Columns("H:H").ColumnWidth = 9
        Columns("I:I").ColumnWidth = 17.57
        Columns("J:J").ColumnWidth = 2.86
        Columns("K:K").ColumnWidth = 9
        Columns("L:L").ColumnWidth = 17.57
        Columns("M:M").ColumnWidth = 1.71
        Columns("N:N").ColumnWidth = 30
        Rows("1:1").RowHeight = 20
        Rows("2:2").RowHeight = 46
        Rows("3:14").RowHeight = 13.5
        Rows("15:15").RowHeight = 20.75
        Rows("16:16").RowHeight = 44.5
        Rows("17:17").RowHeight = 46
        Rows("18:29").RowHeight = 13.5
        Rows("30:30").RowHeight = 20.75
        Rows("31:31").RowHeight = 20
        Rows("32:32").RowHeight = 75
        With ActiveSheet.PageSetup
            .PrintArea = "A1:M31"
            .LeftMargin = Application.InchesToPoints(0)
            .RightMargin = Application.InchesToPoints(0)
            .TopMargin = Application.InchesToPoints(0)
            .BottomMargin = Application.InchesToPoints(0)
            .HeaderMargin = Application.InchesToPoints(0)
            .FooterMargin = Application.InchesToPoints(0)
            .PrintQuality = 600
            .CenterHorizontally = True
            .CenterVertically = True
            .Orientation = xlLandscape
            .BlackAndWhite = False
            .Zoom = 100
        End With
        With Range("A2:A15,D2:D15,G2:G15,J2:J15,M2:M15,A17:A30,D17:D30,G17:G30,J17:J30,M17:M30,A1:M1,A16:M16,A31:M31")
            .MergeCells = True
        End With
        With Range("A1:M31")
            .Locked = True
            .ClearContents
            .Borders.LineStyle = xlNone
            .FormulaHidden = True
            .Orientation = 0
            .HorizontalAlignment = xlCenter
            .VerticalAlignment = xlCenter
            .WrapText = False
            .ShrinkToFit = True
            .NumberFormat = "General"
            With .Interior
                .PatternColorIndex = xlAutomatic
                .PatternTintAndShade = 0
                .Pattern = xlNone
            End With
            With .Font
                .ShrinkToFit = True
                .WrapText = False
                .Name = "Arial"
                .Size = 10
                .Bold = True
                .Italic = False
                .ColorIndex = 1
            End With
        End With
    Application.Run "Fixed_Range_Names"
'Formatting
        With Range("CLASS_F1,CLASS_F2,CLASS_F3,CLASS_F4,CLASS_F5,CLASS_F6,CLASS_F7,CLASS_F8")
            .MergeCells = True
            With .Font
                .Size = 16
                .ShrinkToFit = False
                .WrapText = True
                .ColorIndex = 3
            End With
        End With
        With Range("WARNING_F1,WARNING_F2,WARNING_F3,WARNING_F4,WARNING_F5,WARNING_F6,WARNING_F7,WARNING_F8")
            .MergeCells = True
            With .Font
                .Size = 8
                .Italic = True
                .ColorIndex = 1
            End With
        End With
        With Range("BARCODE_F1,BARCODE_F2,BARCODE_F3,BARCODE_F4,BARCODE_F5,BARCODE_F6,BARCODE_F7,BARCODE_F8")
            .MergeCells = True
            .Font.ColorIndex = 3
        End With
        With Range("SERIAL_F1,SERIAL_F2,SERIAL_F3,SERIAL_F4,SERIAL_F5,SERIAL_F6,SERIAL_F7,SERIAL_F8")
            .MergeCells = True
            .Locked = False
            With .Font
                .Size = 14
                .ColorIndex = 3
            End With
            With .Validation
                .Delete
                .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
                xlBetween, Formula1:="=SERIALFIXED"
                .IgnoreBlank = True
                .InCellDropdown = True
                .InputTitle = ""
                .ErrorTitle = ""
                .InputMessage = ""
                .ErrorMessage = ""
                .ShowInput = False
                .ShowError = False
            End With
        End With
        With Range("CONTACT_F1,CONTACT_F2,CONTACT_F3,CONTACT_F4,CONTACT_F5,CONTACT_F6,CONTACT_F7,CONTACT_F8")
            .MergeCells = True
            .ShrinkToFit = False
            .WrapText = True
            With .Font
                .Size = 8
                .Italic = True
                .ColorIndex = 1
            End With
        End With
'Formulas
    'Position 1
        Range("TYPE_F1").Formula = "=IFERROR(VLOOKUP(SERIAL_F1,Fixed_Data!$A:$J,3,FALSE),"""")"
        Range("BARCODE_F1").Formula = "=IFERROR(VLOOKUP(SERIAL_F1,Fixed_Data!$A:$J,2,FALSE),"""")"
        Range("LOC_F1").Formula = "=IFERROR(VLOOKUP(SERIAL_F1,Fixed_Data!$A:$J,10,FALSE),"""")"
        Range("ROUTE_F1").Formula = "=IFERROR(VLOOKUP(SERIAL_F1,Fixed_Data!$A:$5,10,FALSE),"""")"
    'Position 2
        Range("TYPE_F2").Formula = "=IFERROR(VLOOKUP(SERIAL_F2,Fixed_Data!$A:$J,3,FALSE),"""")"
        Range("BARCODE_F2").Formula = "=IFERROR(VLOOKUP(SERIAL_F2,Fixed_Data!$A:$J,2,FALSE),"""")"
        Range("LOC_F2").Formula = "=IFERROR(VLOOKUP(SERIAL_F2,Fixed_Data!$A:$J,10,FALSE),"""")"
        Range("ROUTE_F2").Formula = "=IFERROR(VLOOKUP(SERIAL_F2,Fixed_Data!$A:$5,10,FALSE),"""")"
    'Position 3
        Range("TYPE_F3").Formula = "=IFERROR(VLOOKUP(SERIAL_F3,Fixed_Data!$A:$J,3,FALSE),"""")"
        Range("BARCODE_F3").Formula = "=IFERROR(VLOOKUP(SERIAL_F3,Fixed_Data!$A:$J,2,FALSE),"""")"
        Range("LOC_F3").Formula = "=IFERROR(VLOOKUP(SERIAL_F3,Fixed_Data!$A:$J,10,FALSE),"""")"
        Range("ROUTE_F3").Formula = "=IFERROR(VLOOKUP(SERIAL_F3,Fixed_Data!$A:$J,5,FALSE),"""")"
    'Position 4
        Range("TYPE_F4").Formula = "=IFERROR(VLOOKUP(SERIAL_F4,Fixed_Data!$A:$J,3,FALSE),"""")"
        Range("BARCODE_F4").Formula = "=IFERROR(VLOOKUP(SERIAL_F4,Fixed_Data!$A:$J,2,FALSE),"""")"
        Range("LOC_F4").Formula = "=IFERROR(VLOOKUP(SERIAL_F4,Fixed_Data!$A:$J,10,FALSE),"""")"
        Range("ROUTE_F4").Formula = "=IFERROR(VLOOKUP(SERIAL_F4,Fixed_Data!$A:$J,5,FALSE),"""")"
    'Position 5
        Range("TYPE_F5").Formula = "=IFERROR(VLOOKUP(SERIAL_F5,Fixed_Data!$A:$J,3,FALSE),"""")"
        Range("BARCODE_F5").Formula = "=IFERROR(VLOOKUP(SERIAL_F5,Fixed_Data!$A:$J,2,FALSE),"""")"
        Range("LOC_F5").Formula = "=IFERROR(VLOOKUP(SERIAL_F5,Fixed_Data!$A:$J,10,FALSE),"""")"
        Range("ROUTE_F5").Formula = "=IFERROR(VLOOKUP(SERIAL_F5,Fixed_Data!$A:$J,5,FALSE),"""")"
    'Position 6
        Range("TYPE_F6").Formula = "=IFERROR(VLOOKUP(SERIAL_F6,Fixed_Data!$A:$J,3,FALSE),"""")"
        Range("BARCODE_F6").Formula = "=IFERROR(VLOOKUP(SERIAL_F6,Fixed_Data!$A:$J,2,FALSE),"""")"
        Range("LOC_F6").Formula = "=IFERROR(VLOOKUP(SERIAL_F6,Fixed_Data!$A:$J,10,FALSE),"""")"
        Range("ROUTE_F6").Formula = "=IFERROR(VLOOKUP(SERIAL_F6,Fixed_Data!$A:$J,5,FALSE),"""")"
    'Position 7
        Range("TYPE_F7").Formula = "=IFERROR(VLOOKUP(SERIAL_F7,Fixed_Data!$A:$J,3,FALSE),"""")"
        Range("BARCODE_F7").Formula = "=IFERROR(VLOOKUP(SERIAL_F7,Fixed_Data!$A:$J,2,FALSE),"""")"
        Range("LOC_F7").Formula = "=IFERROR(VLOOKUP(SERIAL_F7,Fixed_Data!$A:$J,10,FALSE),"""")"
        Range("ROUTE_F7").Formula = "=IFERROR(VLOOKUP(SERIAL_F7,Fixed_Data!$A:$J,5,FALSE),"""")"
    'Position 8
        Range("TYPE_F8").Formula = "=IFERROR(VLOOKUP(SERIAL_F8,Fixed_Data!$A:$J,3,FALSE),"""")"
        Range("BARCODE_F8").Formula = "=IFERROR(VLOOKUP(SERIAL_F8,Fixed_Data!$A:$J,2,FALSE),"""")"
        Range("LOC_F8").Formula = "=IFERROR(VLOOKUP(SERIAL_F8,Fixed_Data!$A:$J,10,FALSE),"""")"
        Range("ROUTE_F8").Formula = "=IFERROR(VLOOKUP(SERIAL_F8,Fixed_Data!$A:$J,5,FALSE),"""")"
'Close Setup
    Range("SERIAL_F1").Select
    ActiveSheet.Protect DrawingObjects:=False, Contents:=True, Scenarios:=True, AllowFormattingCells:=True
    Application.EnableEvents = True
    Application.Calculation = xlCalculationAutomatic
    Application.DisplayStatusBar = True
    Application.ScreenUpdating = True
End Sub

This is the named range call (Edited to show just one, save a little space)

Code:
Private Sub Fixed_Range_Names()
'Range Names (makes the duplication of code easier)
        Range("B2:C15").Name = "FIXED_1"
        Range("E2:F15").Name = "FIXED_2"
        Range("H2:I15").Name = "FIXED_3"
        Range("K2:L15").Name = "FIXED_4"
        Range("B17:C30").Name = "FIXED_5"
        Range("E17:F30").Name = "FIXED_6"
        Range("H17:I30").Name = "FIXED_7"
        Range("K17:L30").Name = "FIXED_8"
    'Position 1
        Range("B2:C2").Name = "CLASS_F1"
        Range("B3:C3").Name = "WARNING_F1"
        Range("B4").Name = "TYPEH_F1"
        Range("C4").Name = "TYPE_F1"
        Range("B5:C7").Name = "BARCODE_F1"
        Range("B8:C9").Name = "SERIAL_F1"
        Range("B8").Name = "SERIAL_F1"
        Range("B10").Name = "DATA1H_F1"
        Range("C10").Name = "DATA1_F1"
        Range("B11").Name = "DATA2H_F1"
        Range("C11").Name = "DATA2_F1"
        Range("B12").Name = "DATA3H_F1"
        Range("C12").Name = "DATA3_F1"
        Range("B13").Name = "LOCH_F1"
        Range("C13").Name = "LOC_F1"
        Range("B14").Name = "ROUTEH_F1"
        Range("C14").Name = "ROUTE_F1"
        Range("B15:C15").Name = "CONTACT_F1"
        Range("B4:C4").Name = "TYPEL_F1"
        Range("B10:C10").Name = "DATA1L_F1"
        Range("B11:C11").Name = "DATA2L_F1"
        Range("B12:C12").Name = "DATA3L_F1"
        Range("B13:C13").Name = "LOCL_F1"
        Range("B14:C14").Name = "ROUTEL_F1"
        Range("B8:C14").Name = "COLOR_F1"
        Range("C10:C14").Name = "FONT_COLOR_F1"

This is the formatting and deformatting of Tag 1 (again, not gonna post all 8, as it's absurdly long code)

Code:
Private Sub Fixed_Tag_1() 'Tag Position 1
On Error Resume Next
ActiveSheet.Unprotect
    Select Case Range("C4").Text
'Erased Tag (Empty)
        Case "", "ASSET" 'White (Empty)
            With Range("FIXED_1")
                .Borders.LineStyle = xlNone
                With .Interior
                    .Pattern = xlNone
                    .ThemeColor = xlNone
                    .TintAndShade = 0
                End With
            End With
            Range("CLASS_F1,WARNING_F1,TYPEH_F1,DATA1L_F1,DATA2L_F1,DATA3L_F1,LOCH_F1,ROUTEH_F1,CONTACT_F1").ClearContents
'Patrol Point Tag (Blue)
        Case "PATROL POINT"
    'Format
            With Range("TYPEL_F1,COLOR_F1").Interior
                .Pattern = xlSolid
                .ThemeColor = xlThemeColorAccent5
                .TintAndShade = 0.799981688894314
            End With
            With Range("CLASS_F1,WARNING_F1,TYPEL_F1,BARCODE_F1,COLOR_F1,CONTACT_F1")
                With .Borders
                    .LineStyle = xlContinuous
                    .ColorIndex = 1
                    .Weight = xlMedium
                End With
                .Borders(xlInsideVertical).LineStyle = xlNone
                .Borders(xlInsideHorizontal).LineStyle = xlNone
            End With
            Range("TYPE_F1,BARCODE_F1,SERIAL_F1,FONT_COLOR_F1").Font.ColorIndex = 3
    'Content
            Range("DATA1L_F1,DATA2L_F1,DATA3L_F1").ClearContents
            Range("CLASS_F1").Formula = "SECURITY ASSET I.D."
            Range("WARNING_F1").Formula = "DO NOT REMOVE OR OBSTRUCT"
            Range("TYPEH_F1").Formula = "EQUIP:"
            Range("LOCH_F1").Formula = "LOC:"
            Range("ROUTEH_F1").Formula = "ROUTE:"
            Range("CONTACT_F1").Formula = "TROUBLE, DAMAGED EQUIPMENT, OR GENERAL INFO CALL X-XXXX"
'Special Systems (Purple)
        Case "ALARM TEST", "FIXED SYSTEM", "EYEWASH", "DISCONNECT SWITCH", "ALARM PANEL"
    'Format
            With Range("TYPEL_F1,COLOR_F1").Interior
                .Pattern = xlSolid
                    .ThemeColor = xlThemeColorAccent4
                    .TintAndShade = 0.599993896298105
            End With
            With Range("CLASS_F1,WARNING_F1,TYPEL_F1,BARCODE_F1,COLOR_F1,CONTACT_F1")
                With .Borders
                    .LineStyle = xlContinuous
                    .ColorIndex = 1
                    .Weight = xlMedium
                End With
                .Borders(xlInsideVertical).LineStyle = xlNone
                .Borders(xlInsideHorizontal).LineStyle = xlNone
            End With
            Range("TYPE_F1,BARCODE_F1,SERIAL_F1,FONT_COLOR_F1").Font.ColorIndex = 3
    'Content
            Range("DATA1L_F1,DATA2L_F1,DATA3L_F1").ClearContents
            Range("CLASS_F1").Formula = "FIRE PROTECTION EQUIPMENT I.D."
            Range("WARNING_F1").Formula = "DO NOT REMOVE OR OBSTRUCT"
            Range("TYPEH_F1").Formula = "EQUIP:"
            Range("DATA3H_F1").Formula = "ASSET:"
            Range("DATA3_F1").Formula = "=IFERROR(VLOOKUP(SERIAL_F1,Fixed_Data!$A:$J,4,FALSE),"""")"
            Range("LOCH_F1").Formula = "LOC:"
            Range("ROUTEH_F1").Formula = "ROUTE:"
            Range("CONTACT_F1").Formula = "TROUBLE, DAMAGED EQUIPMENT, OR GENERAL INFO CALL X-XXXX"
'Hazards (Yellow)
        Case "SMALL STORAGE", "HAZARD"
    'Format
            With Range("TYPEL_F1,COLOR_F1").Interior
                .Pattern = xlSolid
                .Color = 65535
                .TintAndShade = 0
            End With
            With Range("CLASS_F1,WARNING_F1,TYPEL_F1,BARCODE_F1,COLOR_F1,CONTACT_F1")
                With .Borders
                    .LineStyle = xlContinuous
                    .ColorIndex = 1
                    .Weight = xlMedium
                End With
                .Borders(xlInsideVertical).LineStyle = xlNone
                .Borders(xlInsideHorizontal).LineStyle = xlNone
            End With
            Range("TYPE_F1,BARCODE_F1,SERIAL_F1,FONT_COLOR_F1").Font.ColorIndex = 3
    'Content
            Range("DATA1L_F1,DATA2L_F1,DATA3L_F1").ClearContents
            Range("CLASS_F1").Formula = "FIRE PROTECTION EQUIPMENT I.D."
            Range("WARNING_F1").Formula = "DO NOT REMOVE OR OBSTRUCT"
            Range("TYPEH_F1").Formula = "EQUIP:"
            Range("DATA3H_F1").Formula = "ASSET:"
            Range("DATA3_F1").Formula = "=IFERROR(VLOOKUP(SERIAL_F1,Fixed_Data!$A:$J,4,FALSE),"""")"
            Range("LOCH_F1").Formula = "LOC:"
            Range("ROUTEH_F1").Formula = "ROUTE:"
            Range("CONTACT_F1").Formula = "TROUBLE, DAMAGED EQUIPMENT, OR GENERAL INFO CALL X-XXXX"
'Emergency Systems (Red)
        Case "PULL STATION", "FIRE DOOR"
    'Format
            With Range("TYPEL_F1,COLOR_F1").Interior
                .Pattern = xlSolid
                .Color = 255
                .TintAndShade = 0
            End With
            With Range("CLASS_F1,WARNING_F1,TYPEL_F1,BARCODE_F1,COLOR_F1,CONTACT_F1")
                With .Borders
                    .LineStyle = xlContinuous
                    .ColorIndex = 1
                    .Weight = xlMedium
                End With
                .Borders(xlInsideVertical).LineStyle = xlNone
                .Borders(xlInsideHorizontal).LineStyle = xlNone
            End With
            Range("TYPE_F1,BARCODE_F1,SERIAL_F1,FONT_COLOR_F1").Font.ColorIndex = 2
    'Content
            Range("DATA1L_F1,DATA2L_F1,DATA3L_F1").ClearContents
            Range("CLASS_F1").Formula = "FIRE PROTECTION EQUIPMENT I.D."
            Range("WARNING_F1").Formula = "DO NOT REMOVE OR OBSTRUCT"
            Range("TYPEH_F1").Formula = "EQUIP:"
            
            Range("DATA3H_F1").Formula = "ASSET:"
            Range("DATA3_F1").Formula = "=IFERROR(VLOOKUP(SERIAL_F1,Fixed_Data!$A:$J,4,FALSE),"""")"
            Range("LOCH_F1").Formula = "LOC:"
            Range("ROUTEH_F1").Formula = "ROUTE:"
            Range("CONTACT_F1").Formula = "TROUBLE, DAMAGED EQUIPMENT, OR GENERAL INFO CALL X-XXXX"
'Suppression System - Valves (Orange)
        Case "VALVE"
    'Format
            With Range("TYPEL_F1,COLOR_F1").Interior
                .Pattern = xlSolid
                .ThemeColor = xlThemeColorAccent6
                .TintAndShade = 0.599993896298105
            End With
            With Range("CLASS_F1,WARNING_F1,TYPEL_F1,BARCODE_F1,COLOR_F1,CONTACT_F1")
                With .Borders
                    .LineStyle = xlContinuous
                    .ColorIndex = 1
                    .Weight = xlMedium
                End With
                .Borders(xlInsideVertical).LineStyle = xlNone
                .Borders(xlInsideHorizontal).LineStyle = xlNone
            End With
            Range("TYPE_F1,BARCODE_F1,SERIAL_F1,FONT_COLOR_F1").Font.ColorIndex = 3
    'Content
            Range("DATA1L_F1,DATA2L_F1,DATA3L_F1").ClearContents
            Range("CLASS_F1").Formula = "FIRE PROTECTION EQUIPMENT I.D."
            Range("WARNING_F1").Formula = "DO NOT REMOVE OR OBSTRUCT"
            Range("TYPEH_F1").Formula = "EQUIP:"
            Range("DATA1H_F1").Formula = "COVERAGE:"
            Range("DATA1_F1").Formula = "=IFERROR(VLOOKUP(SERIAL_F1,Fixed_Data!$A:$J,6,FALSE),"""")"
            Range("DATA2H_F1").Formula = "RISER:"
            Range("DATA2_F1").Formula = "=IFERROR(VLOOKUP(SERIAL_F1,Fixed_Data!$A:$J,8,FALSE),"""")"
            Range("DATA3H_F1").Formula = "INSPECTOR:"
            Range("DATA3_F1").Formula = "=IFERROR(VLOOKUP(SERIAL_F1,Fixed_Data!$A:$J,9,FALSE),"""")"
            Range("LOCH_F1").Formula = "LOC:"
            Range("ROUTEH_F1").Formula = "ROUTE:"
            Range("CONTACT_F1").Formula = "TROUBLE, DAMAGED EQUIPMENT, OR GENERAL INFO CALL X-XXXX"
'Suppression System - Risers (Orange)
        Case "RISER"
    'Format
            With Range("TYPEL_F1,COLOR_F1").Interior
                .Pattern = xlSolid
                .ThemeColor = xlThemeColorAccent6
                .TintAndShade = 0.599993896298105
            End With
            With Range("CLASS_F1,WARNING_F1,TYPEL_F1,BARCODE_F1,COLOR_F1,CONTACT_F1")
                With .Borders
                    .LineStyle = xlContinuous
                    .ColorIndex = 1
                    .Weight = xlMedium
                End With
                .Borders(xlInsideVertical).LineStyle = xlNone
                .Borders(xlInsideHorizontal).LineStyle = xlNone
            End With
            Range("TYPE_F1,BARCODE_F1,SERIAL_F1,FONT_COLOR_F1").Font.ColorIndex = 3
    'Content
            Range("DATA1L_F1,DATA2L_F1,DATA3L_F1").ClearContents
            Range("CLASS_F1").Formula = "FIRE PROTECTION EQUIPMENT I.D."
            Range("WARNING_F1").Formula = "DO NOT REMOVE OR OBSTRUCT"
            Range("TYPEH_F1").Formula = "EQUIP:"
            Range("DATA1H_F1").Formula = "COVERAGE:"
            Range("DATA1_F1").Formula = "=IFERROR(VLOOKUP(SERIAL_F1,Fixed_Data!$A:$J,6,FALSE),"""")"
            Range("DATA2H_F1").Formula = "VALVE:"
            Range("DATA2_F1").Formula = "=IFERROR(VLOOKUP(SERIAL_F1,Fixed_Data!$A:$J,7,FALSE),"""")"
            Range("DATA3H_F1").Formula = "INSPECTOR:"
            Range("DATA3_F1").Formula = "=IFERROR(VLOOKUP(SERIAL_F1,Fixed_Data!$A:$J,9,FALSE),"""")"
            Range("LOCH_F1").Formula = "LOC:"
            Range("ROUTEH_F1").Formula = "ROUTE:"
            Range("CONTACT_F1").Formula = "TROUBLE, DAMAGED EQUIPMENT, OR GENERAL INFO CALL X-XXXX"
'Suppression System - Inspector Tests (Orange)
        Case "WATERFLOW TEST"
    'Format
            With Range("TYPEL_F1,COLOR_F1").Interior
                .Pattern = xlSolid
                .ThemeColor = xlThemeColorAccent6
                .TintAndShade = 0.599993896298105
            End With
            With Range("CLASS_F1,WARNING_F1,TYPEL_F1,BARCODE_F1,COLOR_F1,CONTACT_F1")
                With .Borders
                    .LineStyle = xlContinuous
                    .ColorIndex = 1
                    .Weight = xlMedium
                End With
                .Borders(xlInsideVertical).LineStyle = xlNone
                .Borders(xlInsideHorizontal).LineStyle = xlNone
            End With
            Range("TYPE_F1,BARCODE_F1,SERIAL_F1,FONT_COLOR_F1").Font.ColorIndex = 3
    'Content
            Range("DATA1L_F1,DATA2L_F1,DATA3L_F1").ClearContents
            Range("CLASS_F1").Formula = "FIRE PROTECTION EQUIPMENT I.D."
            Range("WARNING_F1").Formula = "DO NOT REMOVE OR OBSTRUCT"
            Range("TYPEH_F1").Formula = "EQUIP:"
            Range("DATA1H_F1").Formula = "COVERAGE:"
            Range("DATA1_F1").Formula = "=IFERROR(VLOOKUP(SERIAL_F1,Fixed_Data!$A:$J,6,FALSE),"""")"
            Range("DATA2H_F1").Formula = "VALVE:"
            Range("DATA2_F1").Formula = "=IFERROR(VLOOKUP(SERIAL_F1,Fixed_Data!$A:$J,7,FALSE),"""")"
            Range("DATA3H_F1").Formula = "RISER:"
            Range("DATA3_F1").Formula = "=IFERROR(VLOOKUP(SERIAL_F1,Fixed_Data!$A:$J,8,FALSE),"""")"
            Range("LOCH_F1").Formula = "LOC:"
            Range("ROUTEH_F1").Formula = "ROUTE:"
            Range("CONTACT_F1").Formula = "TROUBLE, DAMAGED EQUIPMENT, OR GENERAL INFO CALL X-XXXX"
'Suppression System - Other (Orange)
        Case "FIRE HYDRANT", "HOSE DROP", "FIRE PUMP"
    'Format
            With Range("TYPEL_F1,COLOR_F1").Interior
                .Pattern = xlSolid
                .ThemeColor = xlThemeColorAccent6
                .TintAndShade = 0.599993896298105
            End With
            With Range("CLASS_F1,WARNING_F1,TYPEL_F1,BARCODE_F1,COLOR_F1,CONTACT_F1")
                With .Borders
                    .LineStyle = xlContinuous
                    .ColorIndex = 1
                    .Weight = xlMedium
                End With
                .Borders(xlInsideVertical).LineStyle = xlNone
                .Borders(xlInsideHorizontal).LineStyle = xlNone
            End With
            Range("TYPE_F1,BARCODE_F1,SERIAL_F1,FONT_COLOR_F1").Font.ColorIndex = 3
    'Content
            Range("DATA1L_F1,DATA2L_F1,DATA3L_F1").ClearContents
            Range("CLASS_F1").Formula = "FIRE PROTECTION EQUIPMENT I.D."
            Range("WARNING_F1").Formula = "DO NOT REMOVE OR OBSTRUCT"
            Range("TYPEH_F1").Formula = "EQUIP:"
            Range("DATA3H_F1").Formula = "ASSET:"
            Range("DATA3_F1").Formula = "=IFERROR(VLOOKUP(SERIAL_F1,Fixed_Data!$A:$J,4,FALSE),"""")"
            Range("LOCH_F1").Formula = "LOC:"
            Range("ROUTEH_F1").Formula = "ROUTE:"
            Range("CONTACT_F1").Formula = "TROUBLE, DAMAGED EQUIPMENT, OR GENERAL INFO CALL X-XXXX"
    End Select
ActiveSheet.Protect DrawingObjects:=False, Contents:=True, Scenarios:=True, AllowFormattingCells:=True
End Sub

And the last block is in the worksheet module. This code was provided to me, but there are a few changes to it, and I'm unsure if these changes are what is causing my barcode images to disappear as new ones are generated.

Code:
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range) ' Barcode Image Code
On Error Resume Next
Application.ScreenUpdating = False
Application.DisplayStatusBar = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False
    Application.Run "Fixed_Tag_1"
    Application.Run "Fixed_Tag_2"
    Application.Run "Fixed_Tag_3"
    Application.Run "Fixed_Tag_4"
    Application.Run "Fixed_Tag_5"
    Application.Run "Fixed_Tag_6"
    Application.Run "Fixed_Tag_7"
    Application.Run "Fixed_Tag_8"
Application.EnableEvents = True
    Const Inset = 5 'distance from picture to cell edges
    Dim Rng As Range
    Dim strPath As String
    Dim strPic As String
    Dim n As Long
    Dim strName As String
    If Not Intersect(Range("SERIAL_F1,SERIAL_F2,SERIAL_F3,SERIAL_F4,SERIAL_F5,SERIAL_F6,SERIAL_F7,SERIAL_F8"), Target) Is Nothing Then
        strPath = ActiveWorkbook.Path
        'strPath = "E:\New Label Project\Barcode" 'You can change this as needed
        If Right(strPath, 1) <> "\" Then
            strPath = strPath & "\"
        End If 'Loop through the modified cells
        For Each Rng In Intersect(Range("SERIAL_F1,SERIAL_F2,SERIAL_F3,SERIAL_F4,SERIAL_F5,SERIAL_F6,SERIAL_F7,SERIAL_F8"), Target)
            n = (Rng.Column + 1) / 3 + (Rng.Row - 8) / 5
            strName = "BARCODE" & Format(n, "00")
            On Error Resume Next 'Try to delete existing picture
            Me.Shapes(strName).Delete
            If Rng.Value = "" Or Rng.Value = "(SERIAL #)" Then 'Do nothing
            Else 'Picture file name
                strPic = Rng.Offset(-3, 0).Value
                With Rng.Offset(-3, 0).Resize(3, 2)
                If strPic <> "" And Dir(strPath & strPic) <> "" Then 'Try to add picture
                    Me.Shapes.AddPicture(Filename:=strPath & strPic, _
                        LinkToFile:=True, SaveWithDocument:=False, _
                        Left:=.Left + 0.25 * Inset, Top:=.Top + 0.25 * Inset, Width:=.Width - Inset, _
                        Height:=.Height - 0.5 * Inset).Name = strName
                End If
                End With
             End If
             On Error GoTo 0
        Next Rng
    End If
Application.DisplayStatusBar = True
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub
 
Last edited:
Upvote 0
I totally forgot to add that this file is primarily used on Excel 2010 and newer, and made the OS is Windows 7.
 
Upvote 0
OK, it seems to me that the Formula that is placed in the initial setup code:

Code:
'Formulas
    'Position 1
        Range("TYPE_F1").Formula = "=IFERROR(VLOOKUP(SERIAL_F1,Fixed_Data!$A:$J,3,FALSE),"""")"
        Range("BARCODE_F1").Formula = "=IFERROR(VLOOKUP(SERIAL_F1,Fixed_Data!$A:$J,2,FALSE),"""")"
        Range("LOC_F1").Formula = "=IFERROR(VLOOKUP(SERIAL_F1,Fixed_Data!$A:$J,10,FALSE),"""")"
        Range("ROUTE_F1").Formula = "=IFERROR(VLOOKUP(SERIAL_F1,Fixed_Data!$A:$5,10,FALSE),"""")"
    'Position 2
        Range("TYPE_F2").Formula = "=IFERROR(VLOOKUP(SERIAL_F2,Fixed_Data!$A:$J,3,FALSE),"""")"
        Range("BARCODE_F2").Formula = "=IFERROR(VLOOKUP(SERIAL_F2,Fixed_Data!$A:$J,2,FALSE),"""")"
        Range("LOC_F2").Formula = "=IFERROR(VLOOKUP(SERIAL_F2,Fixed_Data!$A:$J,10,FALSE),"""")"
        Range("ROUTE_F2").Formula = "=IFERROR(VLOOKUP(SERIAL_F2,Fixed_Data!$A:$5,10,FALSE),"""")"
    'Position 3
        Range("TYPE_F3").Formula = "=IFERROR(VLOOKUP(SERIAL_F3,Fixed_Data!$A:$J,3,FALSE),"""")"
        Range("BARCODE_F3").Formula = "=IFERROR(VLOOKUP(SERIAL_F3,Fixed_Data!$A:$J,2,FALSE),"""")"
        Range("LOC_F3").Formula = "=IFERROR(VLOOKUP(SERIAL_F3,Fixed_Data!$A:$J,10,FALSE),"""")"
        Range("ROUTE_F3").Formula = "=IFERROR(VLOOKUP(SERIAL_F3,Fixed_Data!$A:$J,5,FALSE),"""")"
    'Position 4
        Range("TYPE_F4").Formula = "=IFERROR(VLOOKUP(SERIAL_F4,Fixed_Data!$A:$J,3,FALSE),"""")"
        Range("BARCODE_F4").Formula = "=IFERROR(VLOOKUP(SERIAL_F4,Fixed_Data!$A:$J,2,FALSE),"""")"
        Range("LOC_F4").Formula = "=IFERROR(VLOOKUP(SERIAL_F4,Fixed_Data!$A:$J,10,FALSE),"""")"
        Range("ROUTE_F4").Formula = "=IFERROR(VLOOKUP(SERIAL_F4,Fixed_Data!$A:$J,5,FALSE),"""")"
    'Position 5
        Range("TYPE_F5").Formula = "=IFERROR(VLOOKUP(SERIAL_F5,Fixed_Data!$A:$J,3,FALSE),"""")"
        Range("BARCODE_F5").Formula = "=IFERROR(VLOOKUP(SERIAL_F5,Fixed_Data!$A:$J,2,FALSE),"""")"
        Range("LOC_F5").Formula = "=IFERROR(VLOOKUP(SERIAL_F5,Fixed_Data!$A:$J,10,FALSE),"""")"
        Range("ROUTE_F5").Formula = "=IFERROR(VLOOKUP(SERIAL_F5,Fixed_Data!$A:$J,5,FALSE),"""")"
    'Position 6
        Range("TYPE_F6").Formula = "=IFERROR(VLOOKUP(SERIAL_F6,Fixed_Data!$A:$J,3,FALSE),"""")"
        Range("BARCODE_F6").Formula = "=IFERROR(VLOOKUP(SERIAL_F6,Fixed_Data!$A:$J,2,FALSE),"""")"
        Range("LOC_F6").Formula = "=IFERROR(VLOOKUP(SERIAL_F6,Fixed_Data!$A:$J,10,FALSE),"""")"
        Range("ROUTE_F6").Formula = "=IFERROR(VLOOKUP(SERIAL_F6,Fixed_Data!$A:$J,5,FALSE),"""")"
    'Position 7
        Range("TYPE_F7").Formula = "=IFERROR(VLOOKUP(SERIAL_F7,Fixed_Data!$A:$J,3,FALSE),"""")"
        Range("BARCODE_F7").Formula = "=IFERROR(VLOOKUP(SERIAL_F7,Fixed_Data!$A:$J,2,FALSE),"""")"
        Range("LOC_F7").Formula = "=IFERROR(VLOOKUP(SERIAL_F7,Fixed_Data!$A:$J,10,FALSE),"""")"
        Range("ROUTE_F7").Formula = "=IFERROR(VLOOKUP(SERIAL_F7,Fixed_Data!$A:$J,5,FALSE),"""")"
    'Position 8
        Range("TYPE_F8").Formula = "=IFERROR(VLOOKUP(SERIAL_F8,Fixed_Data!$A:$J,3,FALSE),"""")"
        Range("BARCODE_F8").Formula = "=IFERROR(VLOOKUP(SERIAL_F8,Fixed_Data!$A:$J,2,FALSE),"""")"
        Range("LOC_F8").Formula = "=IFERROR(VLOOKUP(SERIAL_F8,Fixed_Data!$A:$J,10,FALSE),"""")"
        Range("ROUTE_F8").Formula = "=IFERROR(VLOOKUP(SERIAL_F8,Fixed_Data!$A:$J,5,FALSE),"""")"
'Close Setup

Does not like using the range name. This works fine when the named range spans a single cell, but these span over 4 merged cells (the SERIAL_F#).

This I can live with, irritating as it is. HOWEVER, none of the formatting code seems to be working (Color, border, etc.) And I still have not figured out why the barcode images disappear. I would appreciate ANY help.
 
Upvote 0

Forum statistics

Threads
1,223,228
Messages
6,170,871
Members
452,363
Latest member
merico17

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
Back
Top