none
Changing Date format of we use excel as a database RRS feed

  • Question

  • Dear All,

    I'm using Excel as database over here. Here is the code. I wish to convert Date format so it can be accessed by dropdowns.\

    Thanks a lot in advance.




    Private Sub ResetData_Click()
        cmbPriority.Clear
    cmbPriority.Text = vbNullString

    cmbState.Clear
    cmbState.Text = vbNullString
    cmbAssigned.Clear
    cmbAssigned.Text = vbNullString
    cmbUrgency.Clear
    cmbUrgency.Text = vbNullString
    cmbImpact.Clear
    cmbImpact.Text = vbNullString
    cmbSLA.Clear
    cmbSLA.Text = vbNullString
    cmbEndDate.Clear
    cmbEndDate.Text = vbNullString




    Sheets("Request Item Charts").Visible = True
    Sheets("Request Item Charts").Select
    Range("dataSet").Select
    Range(Selection, Selection.End(xlDown)).ClearContents
    End Sub

    Private Sub ShowData_Click()


        'populate data
        strSQL = "SELECT * FROM [Request Item$] WHERE "
    If cmbPriority.Text <> "" Then
    strSQL = strSQL & "[Priority]='" & cmbPriority.Text & "'"
    End If



    If cmbState.Text <> "" Then
    If cmbPriority.Text <> " " Then
    strSQL = strSQL & " AND [State]='" & cmbState.Text & "'"
    Else
    strSQL = strSQL & "[State]='" & cmbState.Text & "'"
    End If
    End If

    If cmbAssigned.Text <> "" Then
    If cmbPriority.Text <> "" Or cmbState.Text <> "" Then
    strSQL = strSQL & " AND [Assigned To]='" & cmbAssigned.Text & "'"
    Else
    strSQL = strSQL & " [Assigned To]='" & cmbAssigned.Text & "'"
    End If
    End If

    If cmbUrgency.Text <> "" Then
    If cmbPriority.Text <> "" Or cmbState.Text <> "" Or cmbAssigned.Text <> "" Then
    strSQL = strSQL & " AND[Urgency]='" & cmbUrgency.Text & "'"
    Else
    strSQL = strSQL & "[Urgency]='" & cmbUrgency.Text & "'"
    End If
    End If

    If cmbImpact.Text <> "" Then
    If cmbPriority.Text <> "" Or cmbState.Text <> "" Or cmbAssigned.Text <> "" Or cmbUrgency.Text <> "" Then
    strSQL = strSQL & " AND[Impact]='" & cmbImpact.Text & "'"
    Else
    strSQL = strSQL & "[Impact]='" & cmbImpact.Text & "'"
    End If
    End If


    If cmbSLA.Text <> "" Then
    If cmbPriority.Text <> "" Or cmbState.Text <> "" Or cmbAssigned.Text <> "" Or cmbUrgency.Text <> "" Or cmbImpact.Text <> "" Then
    strSQL = strSQL & " AND[Impact]='" & cmbImpact.Text & "'"
    Else
    strSQL = strSQL & "[Impact]='" & cmbImpact.Text & "'"
    End If
    End If



    If cmbEndDate.Text <> "" Then

    If cmbPriority.Text <> "" Or cmbState.Text <> "" Or cmbAssigned.Text <> "" Or cmbUrgency.Text <> "" Or cmbImpact.Text <> "" Or cmbSLA.Text <> "" Then

    strSQL = strSQL & " AND[Work End Date]='#" & cmbEndDate.Text & "#'"
    Else
    strSQL = strSQL & "[Work End Date]='#" & cmbEndDate.Text & "#'"

    End If
    End If



    If cmbPriority.Text <> "" Or cmbState.Text <> "" Or cmbAssigned.Text <> "" Or cmbUrgency.Text <> "" Or cmbImpact.Text <> "" Or cmbSLA.Text <> "" Or cmbEndDate.Text <> "" Then

            closeRS
            
            OpenDB
            
            rs.Open strSQL, cnn, adOpenKeyset, adLockOptimistic
            If rs.RecordCount > 0 Then
                Sheets("Request Item Charts").Visible = True
    Sheets("Request Item Charts").Select
    Range("dataSet").Select
    Range(Selection, Selection.End(xlDown)).ClearContents
                
                'Now putting the data on the sheet
                ActiveCell.CopyFromRecordset rs
            Else
                MsgBox "I was not able to find any matching records.", vbExclamation + vbOKOnly
                Exit Sub
            End If

            'Now getting the totals using Query
            If cmbPriority.Text <> "" And cmbState.Text <> "" And cmbAssigned.Text <> "" And cmbUrgency.Text <> " " And cmbImpact.Text <> " " And cmbSLA.Text <> " " Then
         




     strSQL = "SELECT Count([Request Item$].[Number]) AS [CountOf Number], [Request Item$].[State] " & _
                " FROM [Request Item$] WHERE ((([Request Item$].[Priority]) = '" & cmbPriority.Text & "' ) And " & _
                " (([Request Item$].[State]) =  '" & cmbState.Text & "' ) And (([Request Item$].[Impact]) =  '" & cmbImpact.Text & "' ) And" & _
                " (([Request Item$].[Urgency])= '" & cmbUrgency.Text & "' )And (([Request Item$].[Made SLA])='" & cmbSLA.Text & "' ) And " & _
                " (([Request Item$].[Work End Date]= '#" & cmbEndDate.Text & "#')) " & _
                " GROUP BY [Request Item$].[State];"

                closeRS
                OpenDB
                
                rs.Open strSQL, cnn, adOpenKeyset, adLockOptimistic
                If rs.RecordCount > 0 Then
                    Range("L6").CopyFromRecordset rs
                Else
                    Range("L6:M7").Clear
                    MsgBox "There was some issue getting the totals.", vbExclamation + vbOKOnly
                    Exit Sub
                End If
            End If
        End If
    End Sub

    Private Sub UpdateDropDown_Click()
      strSQL = "Select Distinct [Priority] From [Request Item$] Order by [Priority]"
     closeRS
        OpenDB
    cmbPriority.Clear

    rs.Open strSQL, cnn, adOpenKeyset, adLockOptimistic

    If rs.RecordCount > 0 Then
    Do While Not rs.EOF And Not rs.BOF

    If Not IsNull(rs.Fields(0)) Then cmbPriority.AddItem rs.Fields(0)
    rs.MoveNext
    Loop
    Else
    MsgBox "I was not able to find any unique Prioritys.", vbCritical + vbOKOnly
    Set rs = Nothing
    Exit Sub
    End If


    '----------------------
    strSQL = "Select Distinct [State] From [Request Item$] Order by [State]"

     closeRS
        OpenDB
    cmbState.Clear

    rs.Open strSQL, cnn, adOpenKeyset, adLockOptimistic

    If rs.RecordCount > 0 Then
    Do While Not rs.EOF

     If Not IsNull(rs.Fields(0)) Then cmbState.AddItem rs.Fields(0)
    rs.MoveNext
    Loop
    Else
    MsgBox "I was not able to find any unique State(s).", vbCritical + vbOKOnly
    Set rs = Nothing
    Exit Sub
    End If


    ''''''''''''''''''''''''''''''''''''''''''''

    strSQL = "Select Distinct [Assigned To] From [Request Item$] Order by [Assigned To]"
     closeRS
        OpenDB
    cmbAssigned.Clear

    rs.Open strSQL, cnn, adOpenKeyset, adLockOptimistic

    If rs.RecordCount > 0 Then
    Do While Not rs.EOF

     If Not IsNull(rs.Fields(0)) Then cmbAssigned.AddItem rs.Fields(0)
    rs.MoveNext
    Loop
    Else
    MsgBox "I was not able to find any unique State(s).", vbCritical + vbOKOnly
    Set rs = Nothing
    Exit Sub
    End If


    '---------------------------------------------------



    strSQL = "Select Distinct [Urgency] From [Request Item$] Order by [Urgency]"
     closeRS
        OpenDB
    cmbUrgency.Clear

    rs.Open strSQL, cnn, adOpenKeyset, adLockOptimistic

    If rs.RecordCount > 0 Then
    Do While Not rs.EOF

     If Not IsNull(rs.Fields(0)) Then cmbUrgency.AddItem rs.Fields(0)
    rs.MoveNext
    Loop
    Else
    MsgBox "I was not able to find any unique State(s).", vbCritical + vbOKOnly
    Set rs = Nothing
    Exit Sub
    End If


    '-------------------------------------------------------------


    strSQL = "Select Distinct [Impact] From [Request Item$] Order by [Impact]"
     closeRS
        OpenDB
    cmbImpact.Clear

    rs.Open strSQL, cnn, adOpenKeyset, adLockOptimistic

    If rs.RecordCount > 0 Then
    Do While Not rs.EOF

     If Not IsNull(rs.Fields(0)) Then cmbImpact.AddItem rs.Fields(0)
    rs.MoveNext
    Loop
    Else
    MsgBox "I was not able to find any unique State(s).", vbCritical + vbOKOnly
    Set rs = Nothing
    Exit Sub
    End If


    '-------------------------------------------------------------------------



    strSQL = "Select Distinct [Made SLA] From [Request Item$] Order by [Made SLA] "

     closeRS
        OpenDB
    cmbSLA.Clear

    rs.Open strSQL, cnn, adOpenKeyset, adLockOptimistic

    If rs.RecordCount > 0 Then
    Do While Not rs.EOF

     If Not IsNull(rs.Fields(0)) Then cmbSLA.AddItem rs.Fields(0)
     
     
     
     
     
    rs.MoveNext
    Loop
    Else
    MsgBox "I was not able to find any unique State(s).", vbCritical + vbOKOnly
    Set rs = Nothing
    Exit Sub
    End If





    '---------------------------------------------------------------------------


    'dvenc1 = Format(Sheets("View").Range("G6").Value, "dd/mm/yyyy")



    strSQL = "Select Distinct [Work End Date] From [Request Item$]   Order by [Work End Date]"

     closeRS
        OpenDB
    cmbEndDate.Clear

    rs.Open strSQL, cnn, adOpenKeyset, adLockOptimistic

    If rs.RecordCount > 0 Then
    Do While Not rs.EOF

     If Not IsNull(rs.Fields(0)) Then cmbEndDate.AddItem rs.Fields(0)
    rs.MoveNext
    Loop
    Else
    MsgBox "I was not able to find any unique State(s).", vbCritical + vbOKOnly
    Exit Sub
    End If

    End Sub


    #excel #vb #vba #Excel #Database #Table #SQL #CHARTS




    Friday, March 25, 2016 11:51 AM

Answers

  • Hi, Diksha Baluja

    You have mentioned that you want to change the date format.

    >> so are your data in sheet?

    From the following way you can change the format of date.

    Sheet1.Range("A2", "A50000") = Format(TextBox1.Value, "yyyy/mm/dd")

    From your code its look like you are taking a value of a date by text box.

    It is better to take value of date by date picker.

    Because from the use of date picker you can directly choose the date no need to enter manually and you can also set format of date with in that.

    >>You need not to post whole code. Post only the code with you are facing problem.

    Regards

    Deepak


    We are trying to better understand customer views on social support experience, so your participation in this interview project would be greatly appreciated if you have time. Thanks for helping make community forums a great place.
    Click HERE to participate the survey.

    Monday, March 28, 2016 6:25 AM
    Moderator