none
why is my columnswidth not working RRS feed

  • Question

  • I have a 9000 plus, 27 column, excel spreadsheet database that I am pulling from to display information in a listbox. I use columnswith to display the stuff I want. For some reason the trailing columns are not displaying. In fact a few column headers are displaying twice (once in the middle then at the end). here is the code

    'Author       : Jim Neely
    'Macro Purpose: To populate a listbox with data from
    '               a worksheet range

    ' Dim variables up here so that they are available to the entire form
    Dim str1 As String, str2 As String, str3 As String, str4 As String, str5 As String, str6 As String, str7 As Integer
    Dim lbtarget As MSForms.ListBox
    Dim lb2Cap As String
    Dim lb3Cap As String
    Dim BgnMo As String
    Dim EndMo As String
    Dim wsht As String
    Dim Res As Variant
    Dim rngSource As Range
    Sub FillVars(ByRef s1 As String, s2 As String, s3 As String, s4 As String, s5 As String, s6 As String, s7 As Integer)
    ' This is the sub that collects the variables from the calling module.
    ' Any form initialization that relies on external variables should be done here.
    Label1.Caption = s1
    ' s1 and s1 are not visible to other Subs in the form,
    str1 = s1 'Label1 Caption
    str2 = s2 'Line
    str3 = s3 'Dept
    str4 = s4 'Machine
    str5 = s5 'Line/Station
    str6 = s6 'Table
    str7 = s7 'Case lookup
    End Sub
    Sub s()
    'Label Caption setup
    Select Case str2
        Case "M200"
            'put M200 in worksheet
            Worksheets("Calibration Schedule").Range("P17").Value = 2 'vlookup on calibration sheet for the Line
            Worksheets("Calibration Schedule").Range("P18").Value = str3 'vlookup on calibration sheet for the Dept
            BgnMo = Worksheets("Calibration Schedule").Range("Q19").Value 'Gets first Mo in the Year for calibration
            EndMo = Worksheets("Calibration Schedule").Range("Q20").Value 'Gets second Mo in the Year for calibration
        Case "Maintenance"
            'Worksheets("Calibration Schedule").Range("P17").Value = 2
            'Worksheets("Calibration Schedule").Range("P18").Value = str3
            BgnMo = "      Aug "
            'EndMo = Worksheets("Calibration Schedule").Range("Q20").Value
        Case "Tool Room"
            'Worksheets("Calibration Schedule").Range("P17").Value = 2
            'Worksheets("Calibration Schedule").Range("P18").Value = str3
            BgnMo = "      Aug "
            'EndMo = Worksheets("Calibration Schedule").Range("Q20").Value
        Case "QA"
            Worksheets("Calibration Schedule").Range("P17").Value = 2
            Worksheets("Calibration Schedule").Range("P18").Value = str3
            BgnMo = "      Feb "
            'EndMo = Worksheets("Calibration Schedule").Range("Q20").Value
        Case "QAI"
            Worksheets("Calibration Schedule").Range("P17").Value = 2
            Worksheets("Calibration Schedule").Range("P18").Value = str3
            BgnMo = "      Feb "
            'EndMo = Worksheets("Calibration Schedule").Range("Q20").Value
        Case "Press"
            Worksheets("Calibration Schedule").Range("P17").Value = 2
            Worksheets("Calibration Schedule").Range("P18").Value = str3
            BgnMo = "       Jan "
            'EndMo = Worksheets("Calibration Schedule").Range("Q20").Value
        Case "B800"
            Worksheets("Calibration Schedule").Range("P17").Value = 3
            Worksheets("Calibration Schedule").Range("P18").Value = str3
            BgnMo = Worksheets("Calibration Schedule").Range("Q19").Value
            EndMo = Worksheets("Calibration Schedule").Range("Q20").Value
        Case "B700"
            Worksheets("Calibration Schedule").Range("P17").Value = 4
            Worksheets("Calibration Schedule").Range("P18").Value = str3
            BgnMo = Worksheets("Calibration Schedule").Range("Q19").Value
            EndMo = Worksheets("Calibration Schedule").Range("Q20").Value
        Case "481K"
            Worksheets("Calibration Schedule").Range("P17").Value = 5
            Worksheets("Calibration Schedule").Range("P18").Value = str3
            BgnMo = Worksheets("Calibration Schedule").Range("Q19").Value
            EndMo = Worksheets("Calibration Schedule").Range("Q20").Value
        Case "423K"
            Worksheets("Calibration Schedule").Range("P17").Value = 6
            Worksheets("Calibration Schedule").Range("P18").Value = str3
            BgnMo = Worksheets("Calibration Schedule").Range("Q19").Value
            EndMo = Worksheets("Calibration Schedule").Range("Q20").Value
        Case "143K"
            Worksheets("Calibration Schedule").Range("P17").Value = 7
            Worksheets("Calibration Schedule").Range("P18").Value = str3
            BgnMo = Worksheets("Calibration Schedule").Range("Q19").Value
            EndMo = Worksheets("Calibration Schedule").Range("Q20").Value
        Case Else
            'Sheets("Gages").Select
    End Select
    'Start of UserForm
    Application.ScreenUpdating = False
    'Clean Worksheet from prior Run
    Worksheets("ListBoxData").Range("A2:W500").Clear
    'Open Gages Database
    Worksheets("Gages").Select
    Application.ScreenUpdating = False
    Range("A1").Select
    Select Case str7
        Case 1
            ActiveSheet.Range("$A$1:$W$10000").AutoFilter Field:=4, Criteria1:="Active" 'Status
            ActiveSheet.Range("$A$1:$W$10000").AutoFilter Field:=10, Criteria1:=str3 'Dept
            lb3Cap = Application.WorksheetFunction.Subtotal(3, Range("$B:$B")) - 1 'counts non-blank cells
            ActiveSheet.Range("$A$1:$W$10000").AutoFilter Field:=11, Criteria1:=str4 'Machine
        Case 2
            ActiveSheet.Range("$A$1:$W$10000").AutoFilter Field:=4, Criteria1:="Active" 'Status
            ActiveSheet.Range("$A$1:$W$10000").AutoFilter Field:=9, Criteria1:=str2 'Line
            ActiveSheet.Range("$A$1:$W$10000").AutoFilter Field:=10, Criteria1:=str3 'Dept
            lb3Cap = Application.WorksheetFunction.Subtotal(3, Range("$B:$B")) - 1
            ActiveSheet.Range("$A$1:$W$10000").AutoFilter Field:=11, Criteria1:=str4 'Machine
            ActiveSheet.Range("$A$1:$W$10000").AutoFilter Field:=12, Criteria1:=str5 'Line/Station
            ActiveSheet.Range("$A$1:$W$10000").AutoFilter Field:=13, Criteria1:=str6 'Table
        Case 3
            ActiveSheet.Range("$A$1:$W$10000").AutoFilter Field:=4, Criteria1:="Active" 'Status
            ActiveSheet.Range("$A$1:$W$10000").AutoFilter Field:=9, Criteria1:=str2 'Line
            ActiveSheet.Range("$A$1:$W$10000").AutoFilter Field:=10, Criteria1:=str3 'Dept
            lb3Cap = Application.WorksheetFunction.Subtotal(3, Range("$B:$B")) - 1
            ActiveSheet.Range("$A$1:$W$10000").AutoFilter Field:=12, Criteria1:=str5 'Line/Station
            ActiveSheet.Range("$A$1:$W$10000").AutoFilter Field:=13, Criteria1:=str6 'Table
        Case 4
            ActiveSheet.Range("$A$1:$W$10000").AutoFilter Field:=4, Criteria1:="Active" 'Status
            ActiveSheet.Range("$A$1:$W$10000").AutoFilter Field:=10, Criteria1:=str3 'Dept
            ActiveSheet.Range("$A$1:$W$10000").AutoFilter Field:=11, Criteria1:=str4 'Machine
            lb3Cap = Application.WorksheetFunction.Subtotal(3, Range("$B:$B")) - 1
            ActiveSheet.Range("$A$1:$W$10000").AutoFilter Field:=12, Criteria1:=str5 'Line/Station
            ActiveSheet.Range("$A$1:$W$10000").AutoFilter Field:=13, Criteria1:=str6 'Table
        Case 5
            ActiveSheet.Range("$A$1:$W$10000").AutoFilter Field:=4, Criteria1:="Active" 'Status
            ActiveSheet.Range("$A$1:$W$10000").AutoFilter Field:=9, Criteria1:=str2 'Line
            lb3Cap = Application.WorksheetFunction.Subtotal(3, Range("$B:$B")) - 1
            ActiveSheet.Range("$A$1:$W$10000").AutoFilter Field:=10, Criteria1:=str3 'Dept
        Case 6
            ActiveSheet.Range("$A$1:$W$10000").AutoFilter Field:=4, Criteria1:="Active" 'Status
            ActiveSheet.Range("$A$1:$W$10000").AutoFilter Field:=11, Criteria1:=str4 'Machine
            lb3Cap = Application.WorksheetFunction.Subtotal(3, Range("$B:$B")) - 1
            ActiveSheet.Range("$A$1:$W$10000").AutoFilter Field:=13, Criteria1:=str6 'Table
        Case 7
            ActiveSheet.Range("$A$1:$W$10000").AutoFilter Field:=4, Criteria1:="Active" 'Status
            ActiveSheet.Range("$A$1:$W$10000").AutoFilter Field:=9, Criterial:=srt2 'Line
            lb3Cap = Application.WorksheetFunction.Subtotal(3, Range("$B:$B")) - 1
            ActiveSheet.Range("$A$1:$W$10000").AutoFilter Field:=10, Criteria1:=str3 'Dept
            ActiveSheet.Range("$A$1:$W$10000").AutoFilter Field:=11, Criteria1:=str4 'Machine
            ActiveSheet.Range("$A$1:$W$10000").AutoFilter Field:=12, Criteria1:=str5 'Line/Station
            ActiveSheet.Range("$A$1:$W$10000").AutoFilter Field:=13, Criteria1:=str6 'Table
        Case 8 'Special Run for B800/B700 Valve Body
            ActiveSheet.Range("$A$1:$W$10000").AutoFilter Field:=4, Criteria1:="Active" 'Status
            ActiveSheet.Range("$A$1:$W$10000").AutoFilter Field:=9, Criteria1:="=B700" _
            , Operator:=xlOr, Criteria2:="=B800"                                         'Line
            ActiveSheet.Range("$A$1:$W$10000").AutoFilter Field:=10, Criteria1:=str3 'Dept
            lb3Cap = Application.WorksheetFunction.Subtotal(3, Range("$B:$B")) - 1
            ActiveSheet.Range("$A$1:$W$10000").AutoFilter Field:=11, Criteria1:=str4 'Machine
            ActiveSheet.Range("$A$1:$W$10000").AutoFilter Field:=12, Criteria1:=str5 'Line/Station
            ActiveSheet.Range("$A$1:$W$10000").AutoFilter Field:=13, Criteria1:=str6 'Table
        Case 9
            ActiveSheet.Range("$A$1:$W$10000").AutoFilter Field:=4, Criteria1:="Active" 'Status
            ActiveSheet.Range("$A$1:$W$10000").AutoFilter Field:=10, Criteria1:=str3 'Dept
            lb3Cap = Application.WorksheetFunction.Subtotal(3, Range("$B:$B")) - 1
            ActiveSheet.Range("$A$1:$W$10000").AutoFilter Field:=12, Criteria1:=str5 'Line/Station
            ActiveSheet.Range("$A$1:$W$10000").AutoFilter Field:=13, Criteria1:=str6 'Table
    End Select
    'Sort the data ascending by Part Number
        ActiveWorkbook.Worksheets("Gages").AutoFilter.Sort.SortFields.Clear
        ActiveWorkbook.Worksheets("Gages").AutoFilter.Sort.SortFields.Add Key:=Range( _
            "A2:A9508"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
            xlSortNormal
        With ActiveWorkbook.Worksheets("Gages").AutoFilter.Sort
            .Header = xlYes
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply
        End With
    '////////////////
    'Begin UserForm Info
    'top right hand corner
    Res = Application.WorksheetFunction.Subtotal(3, Range("$B:$B")) - 1
    lb2Cap = Application.WorksheetFunction.Subtotal(3, Range("$B:$B")) - 1
    If str2 = "B800" And str3 = "VB" Then
    Label3.Caption = Res & " of " & lb3Cap & " B800/B700 Gages"
    Else
    Label3.Caption = "      " & Res & " of " & lb3Cap & " Gages"
    End If
    If str3 = "Assembly" Then
    Label2.Caption = "Calibration Schedule" & vbCrLf & "       " & BgnMo & "   " & EndMo & "" & vbCrLf & " Torque Wrench are" & vbCrLf & "    on 4Mo Schedule" & vbCrLf & "    APR  AUG   DEC"
    Else
    Label2.Caption = "Calibration Schedule" & vbCrLf & "       " & BgnMo & "   " & EndMo
    'End of UserForm Info
    '/////////////////
    End If
    'Following line copies all visible data including the column headers
    'to another worksheet.
    Worksheets("Gages").AutoFilter.Range.SpecialCells(xlCellTypeVisible).Copy _
            Destination:=Worksheets("ListBoxData").Range("A1")
    Selection.AutoFilter
    'Following assigns the data only (excluding the column headers) to rngSource
    With Worksheets("ListBoxData")
    'Set rngSource = .Range(.Cells(2, "A"), .Cells(.Rows.count, "W").End(xlUp))
    Set rngSource = .Range("A2:W1450")
    End With
    ListBox1.Clear
    'Fill the listbox
    Set lbtarget = Me.ListBox1
    With lbtarget
        'Determine number of columns
        .ColumnCount = 27
        'Set column widths
        .ColumnWidths = "105;65;125;0;0;35;30;30;0;0;0;0;0;0;0;0;40;40;40;40;120;120;20;220;120;20;20"
        'Use the above line for Development and the below line for Operations
        '.ColumnWidths = "100;65;125;30;30;30;40;40;40;0;0;0;0;0;0;100;20;0;0"
        'Insert the range of data supplied
        .ColumnHeads = True
        '.List = rngSource.Cells.Value
        .RowSource = rngSource.Address(External:=True)
    End With
    Worksheets("Gages").Select
    Range("A1").Select
    Sheets("Floor Plan").Select
    Application.ScreenUpdating = True
    End Sub

    here is module

    Sub M200_Hub_Station_T1_Click()
    Dim LabelA As String, labelB As String, labelC As String, labelD As String, labelE As String, labelF As String, labelG As Integer
         
        LabelA = "M200 Hub Station - Table 1"
        labelB = "M200"
        labelC = "Hub"
        labelE = "S"
        labelF = "T1"
        labelG = 3
         ' MUST load the form first!
        Load MR0009T1
         ' Send the variables over to the form
        Call MR0009T1.FillVars(LabelA, labelB, labelC, labelD, labelE, labelF, labelG)
        Call MR0009T1.s
         ' Now show the form
        MR0009T1.Show
    End Sub

    here is database

    Part Number Serial Number Description Status Type Range Lower Upper Line Dept Machine Line/Station Table/Rack/Stand/Cart Mo1-4 Mo5-8 Mo9-12 Model 1 2 3 Comments Asset Mgnt Tag
    SC-0001 1 Special Caliper Active         B700 OP   S S9     12 EIW-4 MPA089 102747TA      
    3P-35061-B700T0-M 025235TA Clutch Hub S/A Active 35061 146.96     B700 Drum Main S T9 4   10   SC1249        
    CD-0000101 0000101 Digital Caliper Active   150     B700 QA       2                
    CD-0000108 0000108 Digital Caliper Retired   100     143K OP       4   10            
    CD-30PSX 0000109 Digital Caliper Active   200     B700 Press PR0010   T2 1     500-704-10          
    CD-0000127 0000127 Digital Caliper Active   200     B700 QA       2                
    CD-0000177 0000177 Digital Caliper Active   100     B700 Press MR0003   T1 1     551-241-10          
    CD-0000250 0000250 Digital Caliper Active   100     B700 QA       2                
    HTD-25R 253 Holtest Micrometer Active         M200 Case   S T5 2 8   468-166       TECLOCK  
    CD-0000376 0000376 Digital Caliper Active   100     B700 Press PR0001   R1 1     551-241-10          


    Jim Neely

    Thursday, May 31, 2012 10:21 AM

Answers

  • I left out this snippet.

    M200 B800 B700 481K 423K 143K
    Housing 5 0 0
    Case 2 6 3
    TC 6 2 4 4
    OP 3 4 6
    Diff 6 0 0
    VB 4 5 5
    Drum 3 4 4 3
    Hub 3 3 1
    Gear 3 3 1
    Heat Treat 1 1 1
    B2C1 4
    Assembly 4 2 2 3
    Torque Wrench 5 2 2
    4
    CASE
    3 Mar
    9 Sept

    =VLOOKUP(P18,P4:V15,P17,FALSE)

    =HLOOKUP(P19,O1:Z2,2,FALSE)

    =P19+6

    =HLOOKUP(P20,O1:Z2,2,FALSE)


    Jim Neely

    • Marked as answer by STARFALLS Monday, June 4, 2012 5:25 AM
    Thursday, May 31, 2012 2:30 PM