Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

Register Log in
  • Congratulations wOOdy-Soft on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Toolbar Button Problem

Status
Not open for further replies.
heprox

heprox

IS-IT--Management
Dec 16, 2002
178
US
I have a toolbar on an application that I use to refresh a flexgrid with different recordsets. Whenever I choose a different button on the toolbar its suppossed to change the columns and records in the flexgrid, however it always just stays the same, what am I missing?

Code: 
Private Sub Toolbar1_ButtonClick(ByVal Button As MSComctlLib.Button)
On Error GoTo errhandler
Select Case ButtonMenu.Index
    Case 1
        Dim strsql_size As String
        Dim inti As Integer
        Dim wasNull As Boolean
        MSFItem.Clear
        MSFItem.Rows = 2
        MSFItem.FormatString = "^SKU                                            |^QTY     |^Size  |^Color  |^First Receive Date  |^UPC   "
        strsql_size = "select a.sku_num, sum(a.avail_qty) qty, b.size_cd, b.color_des, b.first_rcv_dt, " & _
            " d.upc_cd from gm_inv_loc a, gm_sku b, gm_itm c, gm_sku2upc_cd d" & _
            " Where a.sku_num = b.sku_num And b.itm_cd = c.itm_cd And b.sku_num = d.sku_num" & _
            " and c.itm_cd = '" & txtItemCode.Text & "' group by a.sku_num, b.size_cd, b.color_des, b.first_rcv_dt, d.upc_cd" & _
            " order by a.sku_num"
        Set rsmain_6 = New ADODB.Recordset
        rsmain_6.Open strsql_size, cn, adOpenKeyset, adLockReadOnly
        If rsmain_6.EOF Then
            MsgBox "This item does not have any current inventory information.", vbCritical, "Error"
            txtSOH.Text = ""
            Exit Sub
        Else
                Do While Not rsmain_6.EOF()
                    If MSFItem.TextMatrix(1, 0) = "" Then
                        inti = 1
                    Else
                        inti = MSFItem.Rows
                        MSFItem.Rows = MSFItem.Rows + 1
                    End If
                    wasNull = False
                    MSFItem.TextMatrix(inti, 0) = rsmain_6("sku_num")
                    MSFItem.TextMatrix(inti, 1) = rsmain_6("qty")
                    MSFItem.TextMatrix(inti, 2) = IfNull(rsmain_6("size_cd"), wasNull, "")
                    MSFItem.TextMatrix(inti, 3) = IfNull(rsmain_6("color_des"), wasNull, "")
                    MSFItem.TextMatrix(inti, 4) = IfNull(rsmain_6("first_rcv_dt"), wasNull, "")
                    MSFItem.TextMatrix(inti, 5) = IfNull(rsmain_6("upc_cd"), wasNull, "")
                    For i = 1 To MSFItem.Rows - 1 Step 2
                            MSFItem.Row = i
                                For j = 0 To MSFItem.Cols - 1
                                    MSFItem.Col = j
                                    MSFItem.CellBackColor = &HC0FFFF
                                Next j
                        Next i
                    rsmain_6.MoveNext
                Loop
        End If
        Exit Sub
    Case 2
        Dim strsql_store As String
        'Dim inti As Integer
        'Dim wasNull As Boolean
        MSFItem.Clear
        MSFItem.Rows = 2
        MSFItem.FormatString = "^Item code     |^QTY   |^Store Code  |^District Code    |^Store Name |^Square Footage  "
        strsql_store = "select a.itm_cd, sum(c.avail_qty) qty, c.store_cd, d.op_dist_cd, d.store_name, " & _
            " d.sq_ft from gm_itm a, gm_sku b, gm_inv_loc c, store d" & _
            " Where a.itm_cd = b.itm_cd And b.sku_num = c.sku_num and c.store_cd = d.store_cd" & _
            " and a.itm_cd = '" & txtItemCode.Text & "'" & _
            " group by a.itm_cd, c.store_cd, d.op_dist_cd, d.store_name, d.sq_ft"
        Set rsmain_7 = New ADODB.Recordset
        rsmain_7.Open strsql_size, cn, adOpenKeyset, adLockReadOnly
        If rsmain_7.EOF Then
            MsgBox "This item does not have any current inventory information.", vbCritical, "Error"
            txtSOH.Text = ""
            Exit Sub
        Else
                Do While Not rsmain_7.EOF()
                    If MSFItem.TextMatrix(1, 0) = "" Then
                        inti = 1
                    Else
                        inti = MSFItem.Rows
                        MSFItem.Rows = MSFItem.Rows + 1
                    End If
                    wasNull = False
                    MSFItem.TextMatrix(inti, 0) = rsmain_7("itm_cd")
                    MSFItem.TextMatrix(inti, 1) = IfNull(rsmain_7("qty"), wasNull, "")
                    MSFItem.TextMatrix(inti, 2) = IfNull(rsmain_7("store_cd"), wasNull, "")
                    MSFItem.TextMatrix(inti, 3) = IfNull(rsmain_7("opt_dist_cd"), wasNull, "")
                    MSFItem.TextMatrix(inti, 4) = IfNull(rsmain_7("store_name"), wasNull, "")
                    MSFItem.TextMatrix(inti, 5) = IfNull(rsmain_7("sq_ft"), wasNull, "")
                    For i = 1 To MSFItem.Rows - 1 Step 2
                            MSFItem.Row = i
                                For j = 0 To MSFItem.Cols - 1
                                    MSFItem.Col = j
                                    MSFItem.CellBackColor = &HC0FFFF
                                Next j
                        Next i
                    rsmain_7.MoveNext
                Loop
        End If
        Exit Sub
    Case 3
        Dim strsql_sku As String
        'Dim inti As Integer
        'Dim wasNull As Boolean
        MSFItem.Clear
        MSFItem.Rows = 2
        MSFItem.FormatString = "^SKU                        |^Size  |^Color |^First Receive Date |^UPC    "
        strsql_sku = "select a.sku_num, sum(a.avail_qty) qty, b.size_cd, b.color_des, a.store_cd, d.store_name, d.op_dist_cd, d.sq_ft," & _
            " b.size_cd, b.color_des from gm_inv_loc a, gm_sku b, gm_itm c, store d" & _
            " Where a.sku_num = b.sku_num And b.itm_cd = c.itm_cd And a.store_cd = d.store_cd" & _
            " and c.itm_cd = '" & txtItemCode.Text & "' group by a.sku_num, b.size_cd, b.color_des, a.store_cd," & _
            " d.store_name , d.op_dist_cd, d.sq_ft, b.size_cd, b.color_des" & _
            " order by a.store_cd, a.sku_num"
        Set rsmain_8 = New ADODB.Recordset
        rsmain_8.Open strsql_size, cn, adOpenKeyset, adLockReadOnly
        If rsmain_8.EOF Then
            MsgBox "This item does not have any current inventory information.", vbCritical, "Error"
            txtSOH.Text = ""
            Exit Sub
        Else
                Do While Not rsmain_8.EOF()
                    If MSFItem.TextMatrix(1, 0) = "" Then
                        inti = 1
                    Else
                        inti = MSFItem.Rows
                        MSFItem.Rows = MSFItem.Rows + 1
                    End If
                    wasNull = False
                    MSFItem.TextMatrix(inti, 0) = rsmain_8("sku_num")
                    MSFItem.TextMatrix(inti, 1) = rsmain_8("qty")
                    MSFItem.TextMatrix(inti, 2) = IfNull(rsmain_8("size_cd"), wasNull, "")
                    MSFItem.TextMatrix(inti, 3) = IfNull(rsmain_8("color_des"), wasNull, "")
                    MSFItem.TextMatrix(inti, 4) = IfNull(rsmain_8("store_cd"), wasNull, "")
                    MSFItem.TextMatrix(inti, 5) = IfNull(rsmain_8("store_name"), wasNull, "")
                    MSFItem.TextMatrix(inti, 5) = IfNull(rsmain_8("op_dist_cd"), wasNull, "")
                    MSFItem.TextMatrix(inti, 5) = IfNull(rsmain_8("sq_ft"), wasNull, "")
                    For i = 1 To MSFItem.Rows - 1 Step 2
                            MSFItem.Row = i
                                For j = 0 To MSFItem.Cols - 1
                                    MSFItem.Col = j
                                    MSFItem.CellBackColor = &HC0FFFF
                                Next j
                        Next i
                    rsmain_8.MoveNext
                Loop
        End If
        Exit Sub
    'Case Else
End Select
errhandler:
    MsgBox "Errors occured while retreiving the item information" & vbCrLf & "Please Click on Reset Button and Redo the process" & vbCrLf & Err.Number & ":" & Err.Description, vbCritical, "Error"
    Exit Sub
End Sub
 
Sort by date Sort by votes
Why do you use ButtonMenu instead of Button.Key?
Are you sure that your buttons do have menu?
Just assign keys to the nuttons and refer them by the keys.

vladk
 
Upvote 0 Downvote
If you indeed use button menus, use _ButtonMenuClick event. Also: the size of your function is too large. It should fit a page.

vladk
 
Upvote 0 Downvote
I'm not familiar with "Button.Key", you have an example?
 
Upvote 0 Downvote
You define strsql_size in case 1 but you try to use it in other cases (??)
 
Upvote 0 Downvote
Right click on your toolbar and open property pages. You will find the plenty of useful fields including the Key.

Dim all your variables in separate upper section of your sub.
 
Upvote 0 Downvote
Each case has its own strsql variable, defined at the beginning:

strsql_size
strsql_store
strsql_sku

?
 
Upvote 0 Downvote
vladk is right about one thing: that function is too large. Especially since it has so much code with conditions (i.e. cases). Try to reduce the code with each case to a few lines, usually to set up parameters for, and call a function that does the main work. At a quick glance it looks as if much of the code in each case is similar enough to make a function/subroutine, with passed parameters making up for the differences.

Advantage: Once you get the function/subroutine debugged for one case, you've only got to allow for the slight differences from case to case, you don't have to test all of the code all over again.


Tracy Dryden

Meddle not in the affairs of dragons,
For you are crunchy, and good with mustard. [dragon]
 
Upvote 0 Downvote
Yup, as vladk suggested, Button.Key is the way to go...

I use it in a Select Case switch...
Code: 
Private Sub Toolbar1_ButtonClick(ByVal Button As MSComctlLib.Button)
  Select Case Button.Key
  Case "New"
    'Code for "New" Button Here
  Case "Open"
    'Code for "Open" Button Here
  Case "Save"
    'Code for "Save" Button Here
  End Select
End Sub

When using keys, you can also refer to buttons as:
ToolBar1.Buttons("Key")
Or...
ToolBar1.Buttons.Item("Key")

Such as:
ToolBar1.Buttons("Open").Visible = False
ToolBar1.Buttons("Save").Enabled = False

This way, if you reorder your buttons at a later time, or insert new ones, you won't have to keep track of indexes...

Visit My Site
PROGRAMMER: (n) Red-eyed, mumbling mammal capable of conversing with inanimate objects.
 
Upvote 0 Downvote
Ok I moved all of my variables to ths start of the function, and I'm trying to use the key value of the button to decide case however I still cant get this thing to work, I've only used a toolbar in one other project, so this is relatively new for me:

Code: 
Private Sub Toolbar1_ButtonClick(ByVal Button As MSComctlLib.Button)
Dim strsql_size As String
Dim strsql_store As String
Dim strsql_sku As String
Dim inti As Integer
Dim wasNull As Boolean
'On Error GoTo errhandler
Select Case Button.Key
    Case bmnSize
        MSFItem.Clear
        MSFItem.Rows = 2
        MSFItem.FormatString = "^SKU      |^QTY   |^Size |^Color    |^First Receive Date   |^UPC     "
        strsql_size = "select a.sku_num, sum(a.avail_qty) qty, b.size_cd, b.color_des, b.first_rcv_dt, " & _
            " d.upc_cd from gm_inv_loc a, gm_sku b, gm_itm c, gm_sku2upc_cd d" & _
            " Where a.sku_num = b.sku_num And b.itm_cd = c.itm_cd And b.sku_num = d.sku_num" & _
            " and c.itm_cd = '" & txtItemCode.Text & "' group by a.sku_num, b.size_cd, b.color_des, b.first_rcv_dt, d.upc_cd" & _
            " order by a.sku_num"
        Set rsmain_6 = New ADODB.Recordset
        rsmain_6.Open strsql_size, cn, adOpenKeyset, adLockReadOnly
        If rsmain_6.EOF Then
            MsgBox "This item does not have any current inventory information.", vbCritical, "Error"
            txtSOH.Text = ""
            Exit Sub
        Else
                Do While Not rsmain_6.EOF()
                    If MSFItem.TextMatrix(1, 0) = "" Then
                        inti = 1
                    Else
                        inti = MSFItem.Rows
                        MSFItem.Rows = MSFItem.Rows + 1
                    End If
                    wasNull = False
                    MSFItem.TextMatrix(inti, 0) = rsmain_6("sku_num")
                    MSFItem.TextMatrix(inti, 1) = rsmain_6("qty")
                    MSFItem.TextMatrix(inti, 2) = IfNull(rsmain_6("size_cd"), wasNull, "")
                    MSFItem.TextMatrix(inti, 3) = IfNull(rsmain_6("color_des"), wasNull, "")
                    MSFItem.TextMatrix(inti, 4) = IfNull(rsmain_6("first_rcv_dt"), wasNull, "")
                    MSFItem.TextMatrix(inti, 5) = IfNull(rsmain_6("upc_cd"), wasNull, "")
                    For i = 1 To MSFItem.Rows - 1 Step 2
                            MSFItem.Row = i
                                For j = 0 To MSFItem.Cols - 1
                                    MSFItem.Col = j
                                    MSFItem.CellBackColor = &HC0FFFF
                                Next j
                        Next i
                    rsmain_6.MoveNext
                Loop
        End If
        Exit Sub
    Case bmnStore
        MSFItem.Clear
        MSFItem.Rows = 2
        MSFItem.FormatString = "^Item code  |^QTY     |^Store Code |^District Code     |^Store Name    |^Square Footage  "
        strsql_store = "select a.itm_cd, sum(c.avail_qty) qty, c.store_cd, d.op_dist_cd, d.store_name, " & _
            " d.sq_ft from gm_itm a, gm_sku b, gm_inv_loc c, store d" & _
            " Where a.itm_cd = b.itm_cd And b.sku_num = c.sku_num and c.store_cd = d.store_cd" & _
            " and a.itm_cd = '" & txtItemCode.Text & "'" & _
            " group by a.itm_cd, c.store_cd, d.op_dist_cd, d.store_name, d.sq_ft"
        Set rsmain_7 = New ADODB.Recordset
        rsmain_7.Open strsql_size, cn, adOpenKeyset, adLockReadOnly
        If rsmain_7.EOF Then
            MsgBox "This item does not have any current inventory information.", vbCritical, "Error"
            txtSOH.Text = ""
            Exit Sub
        Else
                Do While Not rsmain_7.EOF()
                    If MSFItem.TextMatrix(1, 0) = "" Then
                        inti = 1
                    Else
                        inti = MSFItem.Rows
                        MSFItem.Rows = MSFItem.Rows + 1
                    End If
                    wasNull = False
                    MSFItem.TextMatrix(inti, 0) = rsmain_7("itm_cd")
                    MSFItem.TextMatrix(inti, 1) = IfNull(rsmain_7("qty"), wasNull, "")
                    MSFItem.TextMatrix(inti, 2) = IfNull(rsmain_7("store_cd"), wasNull, "")
                    MSFItem.TextMatrix(inti, 3) = IfNull(rsmain_7("opt_dist_cd"), wasNull, "")
                    MSFItem.TextMatrix(inti, 4) = IfNull(rsmain_7("store_name"), wasNull, "")
                    MSFItem.TextMatrix(inti, 5) = IfNull(rsmain_7("sq_ft"), wasNull, "")
                    For i = 1 To MSFItem.Rows - 1 Step 2
                            MSFItem.Row = i
                                For j = 0 To MSFItem.Cols - 1
                                    MSFItem.Col = j
                                    MSFItem.CellBackColor = &HC0FFFF
                                Next j
                        Next i
                    rsmain_7.MoveNext
                Loop
        End If
        Exit Sub
    Case bmnSKU
        MSFItem.Clear
        MSFItem.Rows = 2
        MSFItem.FormatString = "^SKU   |^QTY  |^Size   |^Color    |^First Receive Date    |^UPC   "
        strsql_sku = "select a.sku_num, sum(a.avail_qty) qty, b.size_cd, b.color_des, a.store_cd, d.store_name, d.op_dist_cd, d.sq_ft," & _
            " b.size_cd, b.color_des from gm_inv_loc a, gm_sku b, gm_itm c, store d" & _
            " Where a.sku_num = b.sku_num And b.itm_cd = c.itm_cd And a.store_cd = d.store_cd" & _
            " and c.itm_cd = '" & txtItemCode.Text & "' group by a.sku_num, b.size_cd, b.color_des, a.store_cd," & _
            " d.store_name , d.op_dist_cd, d.sq_ft, b.size_cd, b.color_des" & _
            " order by a.store_cd, a.sku_num"
        Set rsmain_8 = New ADODB.Recordset
        rsmain_8.Open strsql_size, cn, adOpenKeyset, adLockReadOnly
        If rsmain_8.EOF Then
            MsgBox "This item does not have any current inventory information.", vbCritical, "Error"
            txtSOH.Text = ""
            Exit Sub
        Else
                Do While Not rsmain_8.EOF()
                    If MSFItem.TextMatrix(1, 0) = "" Then
                        inti = 1
                    Else
                        inti = MSFItem.Rows
                        MSFItem.Rows = MSFItem.Rows + 1
                    End If
                    wasNull = False
                    MSFItem.TextMatrix(inti, 0) = rsmain_8("sku_num")
                    MSFItem.TextMatrix(inti, 1) = rsmain_8("qty")
                    MSFItem.TextMatrix(inti, 2) = IfNull(rsmain_8("size_cd"), wasNull, "")
                    MSFItem.TextMatrix(inti, 3) = IfNull(rsmain_8("color_des"), wasNull, "")
                    MSFItem.TextMatrix(inti, 4) = IfNull(rsmain_8("store_cd"), wasNull, "")
                    MSFItem.TextMatrix(inti, 5) = IfNull(rsmain_8("store_name"), wasNull, "")
                    MSFItem.TextMatrix(inti, 5) = IfNull(rsmain_8("op_dist_cd"), wasNull, "")
                    MSFItem.TextMatrix(inti, 5) = IfNull(rsmain_8("sq_ft"), wasNull, "")
                    For i = 1 To MSFItem.Rows - 1 Step 2
                            MSFItem.Row = i
                                For j = 0 To MSFItem.Cols - 1
                                    MSFItem.Col = j
                                    MSFItem.CellBackColor = &HC0FFFF
                                Next j
                        Next i
                    rsmain_8.MoveNext
                Loop
        End If
        Exit Sub
    'Case Else
End Select
errhandler:
    MsgBox "Errors occured while retreiving the item information" & vbCrLf & "Please Click on Reset Button and Redo the process" & vbCrLf & Err.Number & ":" & Err.Description, vbCritical, "Error"
    Exit Sub
End Sub

...once I get the mechanics of the function working I'll go back and figure out how to simplify the whole thing with a public function.
 
Upvote 0 Downvote
In this case the term "key" means "key string for the item" not "key on the keyboard". In this context the term "key" can be confusing, especially in juxtapositon with "button".

Tracy Dryden

Meddle not in the affairs of dragons,
For you are crunchy, and good with mustard. [dragon]
 
Upvote 0 Downvote
Ok, got it working, thanks everyone, now I can get started simplifying the function altogether, anyone got any ideas?
 
Upvote 0 Downvote
Start by looking at what the code in each case has in common, and what can be passed as a parameter to generalize the code.


Tracy Dryden

Meddle not in the affairs of dragons,
For you are crunchy, and good with mustard. [dragon]
 
Upvote 0 Downvote
I think I would do something like this:
Code: 
Private Sub Toolbar1_ButtonClick(ByVal Button As MSComctlLib.Button)
  Dim strsql As String
  Dim inti As Integer
  Dim wasNull As Boolean
  On Error GoTo errhandler
  With MSFItem
    .Clear
    .Rows = 2
    Select Case Button.Key
    Case "bmnSize"
      .FormatString = "^SKU  |^QTY    |^Size     |Color    |^First Receive Date |^UPC     " 
    strsql = "select a.sku_num, sum(a.avail_qty) qty, b.size_cd, b.color_des, b.first_rcv_dt, " & _
        " d.upc_cd from gm_inv_loc a, gm_sku b, gm_itm c, gm_sku2upc_cd d" & _
        " Where a.sku_num = b.sku_num And b.itm_cd = c.itm_cd And b.sku_num = d.sku_num" & _
        " and c.itm_cd = '" & txtItemCode.Text & "' group by a.sku_num, b.size_cd, b.color_des, b.first_rcv_dt, d.upc_cd" & _
        " order by a.sku_num"
    Case "bmnStore"
      .FormatString = "^Item code   |^QTY   |^Store Code                           |^District Code    |^Store Name |^Square Footage     "

      strsql = "select a.itm_cd, sum(c.avail_qty) qty, c.store_cd, d.op_dist_cd, d.store_name, " & _
        " d.sq_ft from gm_itm a, gm_sku b, gm_inv_loc c, store d" & _
        " Where a.itm_cd = b.itm_cd And b.sku_num = c.sku_num and c.store_cd = d.store_cd" & _
        " and a.itm_cd = '" & txtItemCode.Text & "'" & _
        " group by a.itm_cd, c.store_cd, d.op_dist_cd, d.store_name, d.sq_ft"
    Case bmnSKU
      .FormatString = "^SKU |^QTY  |^Size    |^Color  |^First Receive Date    |^UPC      =   strsql = "select a.sku_num, sum(a.avail_qty) qty, b.size_cd, b.color_des, a.store_cd, d.store_name, d.op_dist_cd, d.sq_ft," & _
        " b.size_cd, b.color_des from gm_inv_loc a, gm_sku b, gm_itm c, store d" & _
        " Where a.sku_num = b.sku_num And b.itm_cd = c.itm_cd And a.store_cd = d.store_cd" & _
        " and c.itm_cd = '" & txtItemCode.Text & "' group by a.sku_num, b.size_cd, b.color_des, a.store_cd," & _
        " d.store_name , d.op_dist_cd, d.sq_ft, b.size_cd, b.color_des" & _
        " order by a.store_cd, a.sku_num"
    End Select
    
    Set rsmain = New ADODB.Recordset
    rsmain.Open strsql_size, cn, adOpenKeyset, adLockReadOnly
    If rsmain.EOF Then
      MsgBox "This item does not have any current inventory information.", vbCritical, "Error"
      txtSOH.Text = ""
      Exit Sub
    Else
      Do While Not rsmain.EOF()
        If .TextMatrix(1, 0) = "" Then
          inti = 1
        Else
          inti = .Rows
          .Rows = .Rows + 1
        End If
        wasNull = False
        Select Case Button.Key
        Case 0
          .TextMatrix(inti, 0) = rsmain("sku_num")
          .TextMatrix(inti, 1) = rsmain("qty")
          .TextMatrix(inti, 2) = IfNull(rsmain("size_cd"), wasNull, "")
          .TextMatrix(inti, 3) = IfNull(rsmain("color_des"), wasNull, "")
          .TextMatrix(inti, 4) = IfNull(rsmain("first_rcv_dt"), wasNull, "")
          .TextMatrix(inti, 5) = IfNull(rsmain("upc_cd"), wasNull, "")
        Case 1
          .TextMatrix(inti, 0) = rsmain("itm_cd")
          .TextMatrix(inti, 1) = IfNull(rsmain("qty"), wasNull, "")
          .TextMatrix(inti, 2) = IfNull(rsmain("store_cd"), wasNull, "")
          .TextMatrix(inti, 3) = IfNull(rsmain("opt_dist_cd"), wasNull, "")
          .TextMatrix(inti, 4) = IfNull(rsmain("store_name"), wasNull, "")
          .TextMatrix(inti, 5) = IfNull(rsmain("sq_ft"), wasNull, "")
        Case 2
          .TextMatrix(inti, 0) = rsmain("sku_num")
          .TextMatrix(inti, 1) = rsmain("qty")
          .TextMatrix(inti, 2) = IfNull(rsmain("size_cd"), wasNull, "")
          .TextMatrix(inti, 3) = IfNull(rsmain("color_des"), wasNull, "")
          .TextMatrix(inti, 4) = IfNull(rsmain("store_cd"), wasNull, "")
          .TextMatrix(inti, 5) = IfNull(rsmain("sq_ft"), wasNull, "")
        End Select
        If inti Mod 2 = 0 Then
          .Row = inti
          For j = 0 To .Cols - 1
            .Col = j
            .CellBackColor = &HC0FFFF
          Next j
        End If
        rsmain.MoveNext
      Loop
    End If
  End With
  Exit Sub
errhandler:
  MsgBox "Errors occured while retreiving the item information" & vbCrLf & "Please Click on Reset Button and Redo the process" & vbCrLf & Err.Number & ":" & Err.Description, vbCritical, "Error"
End Sub

Notes:
RSMain_6, _7, & _8 combined into RSMain
Main Loop combined and second Select Case added
MSFItem moved to With statement
strsql_size, _store , _sku combined into strsql

Good Luck,
Josh

Visit My Site
PROGRAMMER: (n) Red-eyed, mumbling mammal capable of conversing with inanimate objects.
 
Upvote 0 Downvote
Oh...
I also changed:
Code: 
        For i = 1 To MSFItem.Rows - 1 Step 2
          MSFItem.Row = i
          For j = 0 To MSFItem.Cols - 1
            MSFItem.Col = j
            MSFItem.CellBackColor = &HC0FFFF
          Next j
        Next i
To:
Code: 
        If inti Mod 2 = 0 Then
          .Row = inti
          For j = 0 To .Cols - 1
            .Col = j
            .CellBackColor = &HC0FFFF
          Next j
        End If

This avoids unnecessary loops...

This could be reduced further to:
Code: 
        If inti Mod 2 = 0 Then
          .Row = inti
          For .Col = 0 To .Cols - 1
            .CellBackColor = &HC0FFFF
          Next
        End If

You could also replace all instances of the inti variable with .Row, there is no reason to have to keep track of a duplicate variable...

Visit My Site
PROGRAMMER: (n) Red-eyed, mumbling mammal capable of conversing with inanimate objects.
 
Upvote 0 Downvote
With your code the function is much simpler, thanks. I keep running into an error though:

"Variable required, can't assign to this expression"

and it stops at:

Code: 
If .Row Mod 2 = 0 Then
          For .Col = 0 To .Cols - 1
            .CellBackColor = &HC0FFFF
          Next
      End If

...it highlights the "For .Col" reference in:

Code: 
For .Col = 0 To .Cols - 1
 
Upvote 0 Downvote
Try switching it back to I or J...
Code: 
For i = 0 To .Cols - 1
  .Col = i
  ...

Visit My Site
PROGRAMMER: (n) Red-eyed, mumbling mammal capable of conversing with inanimate objects.
 
Upvote 0 Downvote
I changed it back to:

Code: 
If .Row Mod 2 = 0 Then
          For j = 0 To .Cols - 1
            .Col = j
            .CellBackColor = &HC0FFFF
          Next j
        End If

...and now when the I call the toolbar button it only populates the first row of the flexgrid. I also fixed the "Case" statement where it populates the flexgris to reflect the correct key. The code now looks like:

Code: 
Private Sub Toolbar1_ButtonClick(ByVal Button As MSComctlLib.Button)
  Dim strsql As String
  Dim wasNull As Boolean
  'On Error GoTo errhandler
  With MSFItem
    .Clear
    .Rows = 2
    Select Case Button.Key
    Case "bmnSize"
      .FormatString = "^SKU  |^QTY   |^Size   |^Color |^First Receive Date  |^UPC     "
    strsql = "select a.sku_num, sum(a.avail_qty) qty, b.size_cd, b.color_des, b.first_rcv_dt, " & _
        " d.upc_cd from gm_inv_loc a, gm_sku b, gm_itm c, gm_sku2upc_cd d" & _
        " Where a.sku_num = b.sku_num And b.itm_cd = c.itm_cd And b.sku_num = d.sku_num" & _
        " and c.itm_cd = '" & txtItemCode.Text & "' group by a.sku_num, b.size_cd, b.color_des, b.first_rcv_dt, d.upc_cd" & _
        " order by a.sku_num"
    Case "bmnStore"
      .FormatString = "^Item code    |^QTY     |^Store Code |^District Code  |^Store Name  |^Square Footage  "
      strsql = "select a.itm_cd, sum(c.avail_qty) qty, c.store_cd, d.op_dist_cd, d.store_name, " & _
        " d.sq_ft from gm_itm a, gm_sku b, gm_inv_loc c, store d" & _
        " Where a.itm_cd = b.itm_cd And b.sku_num = c.sku_num and c.store_cd = d.store_cd" & _
        " and a.itm_cd = '" & txtItemCode.Text & "'" & _
        " group by a.itm_cd, c.store_cd, d.op_dist_cd, d.store_name, d.sq_ft"
    Case "bmnSKU"
      .FormatString = "^SKU  |^QTY  |^Size   |^Color   |^Store Code  |^Store Name  |^District Code  |^Square Footage "
      strsql = "select a.sku_num, sum(a.avail_qty) qty, b.size_cd, b.color_des, a.store_cd, d.store_name, d.op_dist_cd, d.sq_ft," & _
        " from gm_inv_loc a, gm_sku b, gm_itm c, store d" & _
        " Where a.sku_num = b.sku_num And b.itm_cd = c.itm_cd And a.store_cd = d.store_cd" & _
        " and c.itm_cd = '" & txtItemCode.Text & "' group by a.sku_num, b.size_cd, b.color_des, a.store_cd," & _
        " d.store_name , d.op_dist_cd, d.sq_ft order by a.store_cd, a.sku_num"
    End Select
  
    Set rsmain = New ADODB.Recordset
    rsmain.Open strsql, cn, adOpenKeyset, adLockReadOnly
    If rsmain.EOF Then
      MsgBox "This item does not have any current inventory information.", vbCritical, "Error"
      txtSOH.Text = ""
      Exit Sub
    Else
      Do While Not rsmain.EOF()
        If .TextMatrix(1, 0) = "" Then
          .Row = 1
        Else
          .Rows = .Rows + 1
        End If
        wasNull = False
        Select Case Button.Key
        Case "bmnSize"
          .TextMatrix(.Row, 0) = rsmain("sku_num")
          .TextMatrix(.Row, 1) = rsmain("qty")
          .TextMatrix(.Row, 2) = IfNull(rsmain("size_cd"), wasNull, "")
          .TextMatrix(.Row, 3) = IfNull(rsmain("color_des"), wasNull, "")
          .TextMatrix(.Row, 4) = IfNull(rsmain("first_rcv_dt"), wasNull, "")
          .TextMatrix(.Row, 5) = IfNull(rsmain("upc_cd"), wasNull, "")
        Case "bmnStore"
          .TextMatrix(.Row, 0) = rsmain("itm_cd")
          .TextMatrix(.Row, 1) = IfNull(rsmain("qty"), wasNull, "")
          .TextMatrix(.Row, 2) = IfNull(rsmain("store_cd"), wasNull, "")
          .TextMatrix(.Row, 3) = IfNull(rsmain("op_dist_cd"), wasNull, "")
          .TextMatrix(.Row, 4) = IfNull(rsmain("store_name"), wasNull, "")
          .TextMatrix(.Row, 5) = IfNull(rsmain("sq_ft"), wasNull, "")
        Case "bmnSKU"
          .TextMatrix(.Row, 0) = rsmain("sku_num")
          .TextMatrix(.Row, 1) = rsmain("qty")
          .TextMatrix(.Row, 2) = IfNull(rsmain("size_cd"), wasNull, "")
          .TextMatrix(.Row, 3) = IfNull(rsmain("color_des"), wasNull, "")
          .TextMatrix(.Row, 4) = IfNull(rsmain("store_cd"), wasNull, "")
          .TextMatrix(.Row, 5) = IfNull(rsmain("store_name"), wasNull, "")
          .TextMatrix(.Row, 6) = IfNull(rsmain("op_dist_cd"), wasNull, "")
          .TextMatrix(.Row, 7) = IfNull(rsmain("sq_ft"), wasNull, "")
        End Select
        
        If .Row Mod 2 = 0 Then
          For j = 0 To .Cols - 1
            .Col = j
            .CellBackColor = &HC0FFFF
          Next j
        End If
        rsmain.MoveNext
      Loop
    End If
  End With
  Exit Sub
errhandler:
  MsgBox "Errors occured while retreiving the item information" & vbCrLf & "Please Click on Reset Button and Redo the process" & vbCrLf & Err.Number & ":" & Err.Description, vbCritical, "Error"
End Sub
 
Upvote 0 Downvote
To populate grid, you can use .AddItem metod. Separate columns with vbTab. This method adds grid row for you.
And you will not need textmatrix in this case as well as
this code will go away:

If .TextMatrix(1, 0) = "" Then
.Row = 1
Else
.Rows = .Rows + 1
End If
...

Assign prefix "bln" to WasNull, use vbNullString instead of "". Instead of rsmain("sku_num") use code like this:
rsmain("sku_num").Value. Instead of &HC0FFFF introduce named constant. Avoid Exit Sub.



vladk
 
Upvote 0 Downvote
vladk said:
Avoid Exit Sub.
Click to expand...

true...

Instead of:
Code: 
  End With
  [b]Exit Sub[/b]
errhandler:
  MsgBox "Errors occured while retreiving the item information" & vbCrLf & "Please Click on Reset Button and Redo the process" & vbCrLf & Err.Number & ":" & Err.Description, vbCritical, "Error"
End Sub
You could use:
Code: 
  End With
errhandler:
[b]If Err Then[/b]
  MsgBox "Errors occured while retreiving the item information" & vbCrLf & "Please Click on Reset Button and Redo the process" & vbCrLf & Err.Number & ":" & Err.Description, vbCritical, "Error"
[b]End If[/b]
End Sub

Err is short hand for Err.Number
If there is an error, Err will be non 0, and the evaluation will result True, otherwise the procedure Exits normally

Visit My Site
PROGRAMMER: (n) Red-eyed, mumbling mammal capable of conversing with inanimate objects.
 
Upvote 0 Downvote
Status
Not open for further replies.

Similar threads

Ken01
  • Locked
  • Question
Problem with CopyMemory statement
Replies
1
Views
322
strongm
strongm
Andrzejek
  • Locked
  • Question
Graphical command button 2
Replies
2
Views
321
Andrzejek
Andrzejek
Raj Gupta
  • Locked
  • Question
VB6 Focus problem after validation
Replies
4
Views
428
strongm
strongm
Ken01
  • Locked
  • Question
Problem with form names in VB6
Replies
3
Views
325
Ken01
Ken01
sal21
  • Locked
  • Question
Pplease for strongm, ftp problem to download file and copy inn c:\tabulati\
Replies
10
Views
533
sal21
sal21

Part and Inventory Search

Sponsor

Back
Top