none
Nested Ifs Or Select Case? RRS feed

  • 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