Answered by:
Nested Ifs Or Select Case?

Question
-
hi
in my form i have 13 textbox (txt1,txt2,....text13) as parameters to search data from my database sheet.
i need to check availability of 13 textbox.value to find how many of them have value to search my data based on their values by clicking search button.
may all textboxes have value or just one of them or non of them it not matter.
i looking for a statement of using nested if or select case for this issue.
pls let me have your good Idea
Nima
Saturday, October 26, 2013 7:19 AM
Answers
-
Nima sent me his workbook, and I wrote the following code for him (it the code for a worksheet named View):
Private Sub OpenDB(ByRef cnn As ADODB.Connection) 'note the change between brackets ByRef cnn As... cnn.ConnectionString = "Driver={Microsoft Excel Driver (*.xls, *.xlsx, *.xlsm, *.xlsb)};DBQ=" & _ ActiveWorkbook.FullName cnn.Open End Sub ' Code to fill View worksheet with filtered records from Data worksheet Private Sub cmdShowData_Click() Dim strSQL As String Dim strWhere As String Dim cnn As New ADODB.Connection Dim rs As ADODB.Recordset Dim rng As Range Application.ScreenUpdating = False Set rs = New ADODB.Recordset 'create a new instance of the recordset 'populate data ============= strSQL = "SELECT Project, Container, Size, [Movement Type], HBL, MBL, Client, Vessel, Voyage, [Dis Date], DoDate, DoFee, Inpart, Line, [POL FWD], [MT Rtn], DMRG, [Settel Date] FROM [data$] " If cmbShptType.Text <> "" Then strWhere = strWhere & " AND [Movement Type] = '" & cmbShptType.Text & "'" End If If cmbLine.Text <> "" Then strWhere = strWhere & " AND [Line] = '" & cmbLine.Text & "'" End If If cmbPolFwd.Text <> "" Then strWhere = strWhere & " AND [POL FWD] = '" & cmbPolFwd.Text & "'" End If If cmbVsl.Text <> "" Then strWhere = strWhere & " AND [Vessel] = '" & cmbVsl.Text & "'" End If If cmbVoy.Text <> "" Then strWhere = strWhere & " AND [Voyage] = '" & cmbVoy.Text & "'" End If If txtArvF.Text <> "" Then strWhere = strWhere & " AND [DIS DATE] >= #" & Format(txtArvF.Text, "yyyy/mm/dd") & "#" End If If txtArvT.Text <> "" Then strWhere = strWhere & " AND [DIS DATE] <= #" & Format(txtArvT.Text, "yyyy/mm/dd") & "#" End If If txtDoF.Text <> "" Then strWhere = strWhere & " AND [DODATE] >= #" & Format(txtDoF.Text, "yyyy/mm/dd") & "#" End If If txtDoT.Text <> "" Then strWhere = strWhere & " AND [DODATE] <= #" & Format(txtDoT.Text, "yyyy/mm/dd") & "#" End If If txtRtnF.Text <> "" Then strWhere = strWhere & " AND [MT RTN] >= #" & Format(txtArvF.Text, "yyyy/mm/dd") & "#" End If If txtRtnT.Text <> "" Then strWhere = strWhere & " AND [MTN RTN] <= #" & Format(txtArvT.Text, "yyyy/mm/dd") & "#" End If If txtSettleF.Text <> "" Then strWhere = strWhere & " AND [SETTEL DATE] >= #" & Format(txtArvF.Text, "yyyy/mm/dd") & "#" End If If txtSettleT.Text <> "" Then strWhere = strWhere & " AND [SETTEL DATE] <= #" & Format(txtArvT.Text, "yyyy/mm/dd") & "#" End If If strWhere <> "" Then ' Drop the first " AND " strWhere = Mid(strWhere, 6) strSQL = strSQL & "WHERE " & strWhere End If Set cnn = New ADODB.Connection OpenDB cnn 'note that we have to add cnn rs.Open strSQL, cnn, adOpenKeyset, adLockOptimistic 'create the recordset Set cnn = Nothing 'dispose the connection and disconnect the recordset 'DO NOT close the connection here as it'll close the recordset as well Set rng = Range("Dataset").Offset(1) Range(rng, rng.End(xlDown)).ClearContents If rs.RecordCount > 0 Then 'Now putting the data on the sheet============= rng.Cells(1).CopyFromRecordset rs rng.Copy Range(rng, rng.End(xlDown)).PasteSpecial xlPasteFormats Application.CutCopyMode = False Range("A1").Select Else MsgBox "I was not able to find any matching records.", vbExclamation End If rs.Close Set rs = Nothing Application.ScreenUpdating = True Sheets("view").Cells.WrapText = False Sheets("view").Columns.ColumnWidth = 10 End Sub '============================================================= 'Updating Fields '============================================================= ' Code to populate some combo boxes on the View sheet Private Sub cmdUpdateDropDowns_Click() Dim cnn As New ADODB.Connection OpenDB cnn 'niFlag = 1 FillCombo Me.cmbShptType, "Movement Type", cnn FillCombo Me.cmbLine, "Line", cnn FillCombo Me.cmbPolFwd, "POL FWD", cnn FillCombo Me.cmbVsl, "Vessel", cnn FillCombo Me.cmbVoy, "Voyage", cnn cnn.Close Set cnn = Nothing End Sub Private Sub FillCombo(ByRef MyCombo As MSForms.ComboBox, ByVal FieldName As String, ByVal cnn As ADODB.Connection) Dim strSQL As String Dim rs As ADODB.Recordset strSQL = "Select Distinct [" & FieldName & "] From [data$] Order by [" & FieldName & "]" MyCombo.Clear Set rs = New ADODB.Recordset rs.Open strSQL, cnn, adOpenKeyset, adLockOptimistic Set cnn = Nothing If rs.RecordCount > 0 Then Do While Not rs.EOF If Not IsNull(rs.Fields(0)) Then MyCombo.AddItem rs.Fields(0) rs.MoveNext Loop Else MsgBox "I was not able to find any unique Products.", vbCritical Set rs = Nothing End If rs.Close Set rs = Nothing End Sub
Nima reported that he was able to use the code and to modify it slightly.Regards, Hans Vogelaar (http://www.eileenslounge.com)
- Marked as answer by Nima Iranian Sunday, October 27, 2013 11:30 AM
Sunday, October 27, 2013 10:24 AM
All replies
-
I'd use a For ... Next loop:
Dim I As Long For I = 1 To 13 If Me.Controls("txt" & I).Value <> "" Then ... End If Next I
Regards, Hans Vogelaar (http://www.eileenslounge.com)
Saturday, October 26, 2013 11:42 AM -
dear Hans,
your msg noted and thanks for you for your immediate replay as always.
could i send you my sample excel file to look at it .is it possible?
thanks
Nima
Saturday, October 26, 2013 1:24 PM -
Perhaps you could create a stripped-down copy of the workbook (without sensitive information) and make it available through one of the websites that let you upload and share a file, such as Windows Live SkyDrive (https://skydrive.live.com), FileDropper (http://filedropper.com) or DropBox (http://www.dropbox.com). Then post a link to the uploaded and shared file here.
If that is problematic, you can send the file to hans dot vogelaar at gmail dot com
Regards, Hans Vogelaar (http://www.eileenslounge.com)
Saturday, October 26, 2013 1:35 PM -
Nima sent me his workbook, and I wrote the following code for him (it the code for a worksheet named View):
Private Sub OpenDB(ByRef cnn As ADODB.Connection) 'note the change between brackets ByRef cnn As... cnn.ConnectionString = "Driver={Microsoft Excel Driver (*.xls, *.xlsx, *.xlsm, *.xlsb)};DBQ=" & _ ActiveWorkbook.FullName cnn.Open End Sub ' Code to fill View worksheet with filtered records from Data worksheet Private Sub cmdShowData_Click() Dim strSQL As String Dim strWhere As String Dim cnn As New ADODB.Connection Dim rs As ADODB.Recordset Dim rng As Range Application.ScreenUpdating = False Set rs = New ADODB.Recordset 'create a new instance of the recordset 'populate data ============= strSQL = "SELECT Project, Container, Size, [Movement Type], HBL, MBL, Client, Vessel, Voyage, [Dis Date], DoDate, DoFee, Inpart, Line, [POL FWD], [MT Rtn], DMRG, [Settel Date] FROM [data$] " If cmbShptType.Text <> "" Then strWhere = strWhere & " AND [Movement Type] = '" & cmbShptType.Text & "'" End If If cmbLine.Text <> "" Then strWhere = strWhere & " AND [Line] = '" & cmbLine.Text & "'" End If If cmbPolFwd.Text <> "" Then strWhere = strWhere & " AND [POL FWD] = '" & cmbPolFwd.Text & "'" End If If cmbVsl.Text <> "" Then strWhere = strWhere & " AND [Vessel] = '" & cmbVsl.Text & "'" End If If cmbVoy.Text <> "" Then strWhere = strWhere & " AND [Voyage] = '" & cmbVoy.Text & "'" End If If txtArvF.Text <> "" Then strWhere = strWhere & " AND [DIS DATE] >= #" & Format(txtArvF.Text, "yyyy/mm/dd") & "#" End If If txtArvT.Text <> "" Then strWhere = strWhere & " AND [DIS DATE] <= #" & Format(txtArvT.Text, "yyyy/mm/dd") & "#" End If If txtDoF.Text <> "" Then strWhere = strWhere & " AND [DODATE] >= #" & Format(txtDoF.Text, "yyyy/mm/dd") & "#" End If If txtDoT.Text <> "" Then strWhere = strWhere & " AND [DODATE] <= #" & Format(txtDoT.Text, "yyyy/mm/dd") & "#" End If If txtRtnF.Text <> "" Then strWhere = strWhere & " AND [MT RTN] >= #" & Format(txtArvF.Text, "yyyy/mm/dd") & "#" End If If txtRtnT.Text <> "" Then strWhere = strWhere & " AND [MTN RTN] <= #" & Format(txtArvT.Text, "yyyy/mm/dd") & "#" End If If txtSettleF.Text <> "" Then strWhere = strWhere & " AND [SETTEL DATE] >= #" & Format(txtArvF.Text, "yyyy/mm/dd") & "#" End If If txtSettleT.Text <> "" Then strWhere = strWhere & " AND [SETTEL DATE] <= #" & Format(txtArvT.Text, "yyyy/mm/dd") & "#" End If If strWhere <> "" Then ' Drop the first " AND " strWhere = Mid(strWhere, 6) strSQL = strSQL & "WHERE " & strWhere End If Set cnn = New ADODB.Connection OpenDB cnn 'note that we have to add cnn rs.Open strSQL, cnn, adOpenKeyset, adLockOptimistic 'create the recordset Set cnn = Nothing 'dispose the connection and disconnect the recordset 'DO NOT close the connection here as it'll close the recordset as well Set rng = Range("Dataset").Offset(1) Range(rng, rng.End(xlDown)).ClearContents If rs.RecordCount > 0 Then 'Now putting the data on the sheet============= rng.Cells(1).CopyFromRecordset rs rng.Copy Range(rng, rng.End(xlDown)).PasteSpecial xlPasteFormats Application.CutCopyMode = False Range("A1").Select Else MsgBox "I was not able to find any matching records.", vbExclamation End If rs.Close Set rs = Nothing Application.ScreenUpdating = True Sheets("view").Cells.WrapText = False Sheets("view").Columns.ColumnWidth = 10 End Sub '============================================================= 'Updating Fields '============================================================= ' Code to populate some combo boxes on the View sheet Private Sub cmdUpdateDropDowns_Click() Dim cnn As New ADODB.Connection OpenDB cnn 'niFlag = 1 FillCombo Me.cmbShptType, "Movement Type", cnn FillCombo Me.cmbLine, "Line", cnn FillCombo Me.cmbPolFwd, "POL FWD", cnn FillCombo Me.cmbVsl, "Vessel", cnn FillCombo Me.cmbVoy, "Voyage", cnn cnn.Close Set cnn = Nothing End Sub Private Sub FillCombo(ByRef MyCombo As MSForms.ComboBox, ByVal FieldName As String, ByVal cnn As ADODB.Connection) Dim strSQL As String Dim rs As ADODB.Recordset strSQL = "Select Distinct [" & FieldName & "] From [data$] Order by [" & FieldName & "]" MyCombo.Clear Set rs = New ADODB.Recordset rs.Open strSQL, cnn, adOpenKeyset, adLockOptimistic Set cnn = Nothing If rs.RecordCount > 0 Then Do While Not rs.EOF If Not IsNull(rs.Fields(0)) Then MyCombo.AddItem rs.Fields(0) rs.MoveNext Loop Else MsgBox "I was not able to find any unique Products.", vbCritical Set rs = Nothing End If rs.Close Set rs = Nothing End Sub
Nima reported that he was able to use the code and to modify it slightly.Regards, Hans Vogelaar (http://www.eileenslounge.com)
- Marked as answer by Nima Iranian Sunday, October 27, 2013 11:30 AM
Sunday, October 27, 2013 10:24 AM -
Dear Mr. Hans,
yes you right my issue is sorted out completely with using your code in my excel file.
many thanks for your good guiding.
Nima
Sunday, October 27, 2013 11:32 AM