Changing the color of a rowc in a FlexGrid, based on a recordset 1

[heprox]

I have an application that users enter in some data and query a data source. The recordsets returned are populated into a FlexGrid and later written to a file. At times there are recordsets that return NULL values for some of the fields. Whenever a recordset has a field with a NULL value I want the entire row to have a different background color. A single query may return several rows of records, but there may only be one that has any NULL values. Here is the code for the query and the population of the FlexGrid:

Private Sub cmdEnter_Click()
On Error GoTo errhandler
Dim strsql As String
Dim inti As Integer
Dim blnflag As Boolean
If txtItemCode.Text = "" Then
MsgBox "Item code cannot be empty, please enter Item Code", vbCritical
txtItemCode.SetFocus
Exit Sub
End If
strsql = " select gm_sku.sku_num, gm_sku.itm_cd, gm_itm.vsn, gm_sku.size_cd, gm_sku.color_des, gm_sku2upc_cd.upc_cd" & _
" from gm_sku, gm_itm , gm_sku2upc_cd" & _
" where gm_sku.sku_num = gm_sku2upc_cd.sku_num(+)" & _
" and gm_sku.itm_cd = gm_itm.itm_cd" & _
" and gm_itm.itm_cd = '" & txtItemCode.Text & "'"
Set rsmain = New ADODB.Recordset
rsmain.Open strsql, cn, adOpenKeyset, adLockReadOnly
If rsmain.EOF Then
MsgBox "UPC data data does not exist for this Item Code or its SKU's in the database...", vbCritical
txtItemCode.Text = ""
txtItemCode.SetFocus
Exit Sub
Else
blnflag = False
For inti = 1 To MSFItem.Rows - 1
If Left(MSFItem.TextMatrix(inti, 0), 9) = txtItemCode.Text Then
blnflag = True
Exit For
End If
Next
If blnflag = False Then
Do While Not rsmain.EOF()
If MSFItem.TextMatrix(1, 0) = "" Then
inti = 1
Else
inti = MSFItem.Rows
MSFItem.Rows = MSFItem.Rows + 1
End If
MSFItem.TextMatrix(inti, 0) = rsmain("sku_num")
MSFItem.TextMatrix(inti, 1) = rsmain("itm_cd")
MSFItem.TextMatrix(inti, 2) = rsmain("vsn")
MSFItem.TextMatrix(inti, 3) = IfNull(rsmain("size_cd"), "NULL")
MSFItem.TextMatrix(inti, 4) = IfNull(rsmain("color_des"), "NULL")
MSFItem.TextMatrix(inti, 5) = IfNull(rsmain("upc_cd"), "NULL")
rsmain.MoveNext
Loop
Else
MsgBox " This Item is already entered", vbInformation
End If
txtItemCode.Text = ""
txtItemCode.SetFocus
Exit Sub
End If
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
Exit Sub
End Sub


...I use a simple Public Function to discern NULL values:

Function IfNull(value As Variant, Optional NullValue As Variant = "") As Variant
If IsNull(value) Then
IfNull = NullValue
Else
IfNull = value
End If
End Function

and here is the code to write the files:

Private Sub cmdSave_Click()
On Error GoTo errhandler
Dim blnWrite As Boolean
Dim strFile As String
Dim iFileNum As Integer
Dim inti As Integer
Dim strRec As String
Const updatecode = 2
If cboStoreNo.Text = "" Then
MsgBox "Please enter the Store number ", vbCritical
cboStoreNo.SetFocus
End If
If mskEffectiveDate.ClipText <> "" Then
If InvalidDate(mskEffectiveDate.Text, Me.Caption) Then
mskEffectiveDate.SetFocus
Exit Sub
End If
Else
MsgBox "Date cannot be empty, Please enter the date", vbCritical
mskEffectiveDate.SetFocus
Exit Sub
End If
If MSFItem.Rows > 2 Then
blnWrite = True
Else
If MSFItem.TextMatrix(1, 0) <> "" Then
blnWrite = True
Else
blnWrite = False
End If
End If
If blnWrite = True Then
OpenFile:
cdlFile.DefaultExt = "asc"
cdlFile.FileName = cboStoreNo.Text & "-" & Format(Date, "mmddyy") & "xreftxn.asc"
cdlFile.ShowSave
If cdlFile.FileName = "" Or cdlFile.FileName = "*.asc" Then
MsgBox "File name cannot be empty/ Invalid File name", vbCritical
GoTo OpenFile
End If
strFile = cdlFile.FileName

'Get a free file handle
iFileNum = FreeFile
Open strFile For Output As iFileNum
For inti = 1 To MSFItem.Rows - 1
strRec = updatecode & "," & """" & Replace(MSFItem.TextMatrix(inti, 0), "-", "") & """" & ",,,," & _
MSFItem.TextMatrix(inti, 5) & ","


Print #iFileNum, strRec

Next
Close iFileNum
MsgBox "File Generated", vbInformation
Call cmdReset_Click
Else
MsgBox "No Item Data has been entered to generate the File, Enter Item code and then click Save button", vbInformation
txtItemCode.SetFocus
Exit Sub
End If
Exit Sub
errhandler:
If Err.Number <> 32755 Then
MsgBox "Errors occured while writing to file" & vbCrLf & Err.Number & ":" & Err.Description, vbCritical
End If
Exit Sub
End Sub

...whenever a record contains NULL values and is colored differently I don't want that particular row to get written to the file, but the rest should. This has really got me perplexed?

 

[ArtieChoke]

Are you asking how to set the row color and detect it so you can omit the row from the file?

"I think we're all Bozos on this bus!" - Firesign Theatre

 

[heprox]

I want the application to change the background color of a row that has NULL values in certain columns so that the user can identify records in the database that may cause issues. The function that prevents these records that have NULL values in some of their fields from printing to the file does not have to be directly linked to the actual code for changing the color. I don't want the records that have NULL values written to the file however. An example would be:

- any records that have a NULL value in either "size_cd", "color_des", or "upc_cd" would have their corresponding row's background color changed and then would not get written to the file when the SAVE function is called.

 

[ArtieChoke]

To set the cell's background color, you can do something like this:

For i = 0 To fg.cols - 1
        fg.col = i
        fg.CellBackColor = vbBlue
    Next

Here's how I would handle detecting if a row is null. Add a parameter to your IfNull function:

Function IfNull(value As Variant, [green]wasNull as boolean,[/green] Optional NullValue As Variant = "") As Variant
    If IsNull(value) Then
        IfNull = NullValue
        [green]wasNull = True[/green]
    Else
        IfNull = value
    End If
End Function

In the section where you are setting the values in the grid, initialize the variable you will use to find out if any null occured:

...
[green]wasNull = False[/green]
MSFItem.TextMatrix(inti, 3) = IfNull(rsmain("size_cd"), [green]wasNull,[/green] "NULL")
MSFItem.TextMatrix(inti, 4) = IfNull(rsmain("color_des"), [green]wasNull,[/green] "NULL")
MSFItem.TextMatrix(inti, 5) = IfNull(rsmain("upc_cd"), [green]wasNull,[/green] "NULL")
[green]if wasNull then
    For i = 0 To MSFItem.cols - 1
        MSFItem.col = i
        MSFItem.CellBackColor = vbBlue
    Next

'   Add a hidden column at the end and set to a value that will show this row contains nulls
'   Note: you will need to set it's cellwidth to 0 to make it hidden

    MSFItem.TextMatrix(inti, 6) = "Null"
endif[/green]
rsmain.MoveNext
...

And in the print routine:

For inti = 1 To MSFItem.Rows - 1
...
   [green]If MSFItem.TextMatrix(inti, 6) <> "Null" Then[/green] Print #iFileNum, strRec
Next

"I think we're all Bozos on this bus!" - Firesign Theatre

 

[heprox]

Thanks for all your help, I'm a little confused about the hidden column part? I added a 7th column through the properties dialog of the FlexGrid, however I'm not familiar enough with the flexgrid control to get how you set the cell width to "0"? Is it done in code? (i.e. msfItem.CellWidth = 0) I also don't get what you mean by, "set to a value that will show this rom contains NULLS"? The NULL values are being returned from the query to the database. Any one of the three columns (size_cd, color_des, upc_cd) could be NULL in any of the records retrieved.

 

[heprox]

Another problem is the declaration of variables here:

Function IfNull(value As Variant, wasNull as boolean, Optional NullValue As Variant = "") As Variant

...apparently VB6 doesn't like declaring variables this way I keep getting ByRef argument mismatch errors because the function basically wants to declare all of this variables as variant?

 

[ArtieChoke]

Yes, you can set it in code. See help for cellwidth. The reason I chose to set a flag in the flexgrid was so I could test for that value in one place. You could ignore all of that part and test for the null value in any of the 3 columns directly and don't print a line if one was found (or the reverse, print a line if no nulls are found). If you ever expand the amount of fields that can have nulls, then you would have to change the test to include those fields.

"I think we're all Bozos on this bus!" - Firesign Theatre

 

[heprox]

The function should only color the background, and prevent the record from being written to file, if the UPC_CD column has a NULL value:

MSFItem.TextMatrix(inti, 5) = IfNull(rsmain("upc_cd"), "NULL")

...the other columns can have NULL values and still print to file accordinhgly. Thats why I was asking about the 7th column and assigning it values there.

I still can't get the function to work correctly with the line:

Function IfNull(value As Variant, wasNull as boolean, Optional NullValue As Variant = "") As Variant

...VB6 does not like to declare variables that way, I keep getting the "byRef mismatch argument" error because we are declaring the line of variables as Variant, but the "wasNull" variable as Boolean. Any way around this?

 

[heprox]

OK I got the variable problem solved, however the function is only coloring the first row in the FlexGrid? I'm lost on how to get it to loop through the grid and identify each row where the UPC_CD column is a NULL value and color that row accordingly? Here is the code ...

Private Sub cmdEnter_Click()
On Error GoTo errhandler
Dim strsql As String
Dim inti As Integer
Dim blnflag As Boolean
Dim wasNull As Boolean
If txtItemCode.Text = "" Then
MsgBox "Item code cannot be empty, please enter an item code", vbCritical
txtItemCode.SetFocus
Exit Sub
End If
strsql = " select gm_sku.sku_num, gm_sku.itm_cd, gm_itm.vsn, gm_sku.size_cd, gm_sku.color_des, gm_sku2upc_cd.upc_cd" & _
" from gm_sku, gm_itm , gm_sku2upc_cd" & _
" where gm_sku.sku_num = gm_sku2upc_cd.sku_num(+)" & _
" and gm_sku.itm_cd = gm_itm.itm_cd" & _
" and gm_itm.itm_cd = '" & txtItemCode.Text & "'"
Set rsmain = New ADODB.Recordset
rsmain.Open strsql, cn, adOpenKeyset, adLockReadOnly
If rsmain.EOF Then
MsgBox "UPC data data does not exist for this Item Code or its SKU's in the database...", vbCritical
txtItemCode.Text = ""
txtItemCode.SetFocus
Exit Sub
Else
blnflag = False
For inti = 1 To MSFItem.Rows - 1
If Left(MSFItem.TextMatrix(inti, 0), 9) = txtItemCode.Text Then
blnflag = True
Exit For
End If
Next
If blnflag = False Then
Do While Not rsmain.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("sku_num")
MSFItem.TextMatrix(inti, 1) = rsmain("itm_cd")
MSFItem.TextMatrix(inti, 2) = rsmain("vsn")
MSFItem.TextMatrix(inti, 3) = IfNull(rsmain("size_cd"), wasNull, "NULL")
MSFItem.TextMatrix(inti, 4) = IfNull(rsmain("color_des"), wasNull, "NULL")
MSFItem.TextMatrix(inti, 5) = IfNull(rsmain("upc_cd"), wasNull, "NULL")
If wasNull Then
For i = 0 To MSFItem.Cols - 1
MSFItem.Col = i
MSFItem.CellBackColor = vbBlue
Next
MSFItem.TextMatrix(inti, 5) = "NULL"
End If
rsmain.MoveNext
Loop
Else
MsgBox " This Item is already entered", vbInformation
End If
txtItemCode.Text = ""
txtItemCode.SetFocus
Exit Sub
End If
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
Exit Sub
End Sub


and the code for the IfNull function:

Function IfNull(value As Variant, wasNull As Boolean, Optional NullValue As Variant = "") As Variant
If IsNull(value) Then
IfNull = NullValue
wasNull = True
Else
IfNull = value
End If
End Function

 

[ArtieChoke]

Since you are using the textmatrix method to populate the grid, the current row is not being set. Add this before trying to change the row color:

MSFItem.Row = inti

"I think we're all Bozos on this bus!" - Firesign Theatre

 

[heprox]

ArtieChoke,

Thanks for all your help, it worked great.

Final Code lookes like:

Private Sub cmdEnter_Click()
On Error GoTo errhandler
Dim strsql As String
Dim inti As Integer
Dim blnflag As Boolean
Dim wasNull As Boolean
If txtItemCode.Text = "" Then
MsgBox "Item code cannot be empty, please enter an item code", vbCritical
txtItemCode.SetFocus
Exit Sub
End If
strsql = " select gm_sku.sku_num, gm_sku.itm_cd, gm_itm.vsn, gm_sku.size_cd, gm_sku.color_des, gm_sku2upc_cd.upc_cd" & _
" from gm_sku, gm_itm , gm_sku2upc_cd" & _
" where gm_sku.sku_num = gm_sku2upc_cd.sku_num(+)" & _
" and gm_sku.itm_cd = gm_itm.itm_cd" & _
" and gm_itm.itm_cd = '" & txtItemCode.Text & "'" & _
" order by gm_sku.sku_num"
Set rsmain = New ADODB.Recordset
rsmain.Open strsql, cn, adOpenKeyset, adLockReadOnly
If rsmain.EOF Then
MsgBox "UPC data data does not exist for this Item Code or its SKU's in the database...", vbCritical
txtItemCode.Text = ""
txtItemCode.SetFocus
Exit Sub
Else
blnflag = False
For inti = 1 To MSFItem.Rows - 1
If Left(MSFItem.TextMatrix(inti, 0), 9) = txtItemCode.Text Then
blnflag = True
Exit For
End If
Next
If blnflag = False Then
Do While Not rsmain.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("sku_num")
MSFItem.TextMatrix(inti, 1) = rsmain("itm_cd")
MSFItem.TextMatrix(inti, 2) = rsmain("vsn")
MSFItem.TextMatrix(inti, 3) = IfNull(rsmain("size_cd"), wasNull, "")
MSFItem.TextMatrix(inti, 4) = IfNull(rsmain("color_des"), wasNull, "")
MSFItem.TextMatrix(inti, 5) = IfNull(rsmain("upc_cd"), wasNull, "")
MSFItem.Row = inti
If wasNull Then
For i = 0 To MSFItem.Cols - 1
MSFItem.Col = i
MSFItem.CellBackColor = vbYellow
MSFItem.CellForeColor = vbRed
MSFItem.CellFontBold = True
Next
MSFItem.TextMatrix(inti, 5) = ""
End If
rsmain.MoveNext
Loop
Else
MsgBox " This Item is already entered", vbInformation
End If
txtItemCode.Text = ""
txtItemCode.SetFocus
Exit Sub
End If
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
Exit Sub
End Sub

Private Sub cmdSave_Click()
On Error GoTo errhandler
Dim blnWrite As Boolean
Dim strFile As String
Dim iFileNum As Integer
Dim inti As Integer
Dim strRec As String
Const updatecode = 2
Dim Response As Integer
Response = MsgBox("This will create a partial PLUU for UPDATES ONLY, do you want to proceed?", vbYesNo + vbQuestion)
If Response = vbYes Then
If cboStoreNo.Text = "" Then
MsgBox "Please enter the Store number ", vbCritical
cboStoreNo.SetFocus
End If
If mskEffectiveDate.ClipText <> "" Then
If InvalidDate(mskEffectiveDate.Text, Me.Caption) Then
mskEffectiveDate.SetFocus
Exit Sub
End If
Else
MsgBox "Date cannot be empty, Please enter the date", vbCritical
mskEffectiveDate.SetFocus
Exit Sub
End If
If MSFItem.Rows > 2 Then
blnWrite = True
Else
If MSFItem.TextMatrix(1, 0) <> "" Then
blnWrite = True
Else
blnWrite = False
End If
End If
If blnWrite = True Then
OpenFile:
cdlFile.DefaultExt = "asc"
cdlFile.FileName = cboStoreNo.Text & "-" & Format(Date, "mmddyy") & "xreftxn.asc"
cdlFile.ShowSave
If cdlFile.FileName = "" Or cdlFile.FileName = "*.asc" Then
MsgBox "File name cannot be empty / Invalid file name", vbCritical
GoTo OpenFile
End If
strFile = cdlFile.FileName

'Get a free file handle
iFileNum = FreeFile
Open strFile For Output As iFileNum
For inti = 1 To MSFItem.Rows - 1
' file format for XREFTXN
strRec = updatecode & "," & """" & Replace(MSFItem.TextMatrix(inti, 0), "-", "") & """" & "," & _
"""" & MSFItem.TextMatrix(inti, 5) & """" & "," & """" & "Y" & """" & ",,"
If MSFItem.TextMatrix(inti, 5) <> "" Then Print #iFileNum, strRec
Next
Close iFileNum
MsgBox "File Created", vbInformation
Call cmdReset_Click
Else
MsgBox "No item data has been entered to generate the file. Please enter an item code and then click Save button", vbInformation
txtItemCode.SetFocus
Exit Sub
End If
Exit Sub
errhandler:
If Err.Number <> 32755 Then
MsgBox "Errors occured while writing to file" & vbCrLf & Err.Number & ":" & Err.Description, vbCritical
End If
Exit Sub
Else
Exit Sub
End If
End Sub

...in the module:

Function IfNull(value As Variant, wasNull As Boolean, Optional NullValue As Variant = "") As Variant
If IsNull(value) Then
IfNull = NullValue
wasNull = True
Else
IfNull = value
End If
End Function

 

[heprox]

ArtieChoke,

You deserve a star for all of your help, thanks again.

 

[ArtieChoke]

"I think we're all Bozos on this bus!" - Firesign Theatre