Excel Hints

Results 1 to 20 of 20

Thread: userform search

  1. #1

    userform search

    Hi all,
    I am new to excel user-form and last couple of days I came up with a user form which consists with "Date, Name, Project, Item, Percentage, Comment". All entries are saved in a sheet call "Data Base".
    I want to make a query using combo boxes. I made an another user-form and add combo boxes for "Date, Name, Project,Item,Percentage" and a command button. Now what I want to do is, if I select one or more values form combo boxes and hit command button, filter relevant Data entries from "Data Base " and Show in a new work sheet.

    please help me to do this.


    thanks in advanced

  2. #2
    hi.
    wellcome to VBAX.

    you can download sample file here to see how to populate a combobox with unique values from range (uses a named range).
    http://www.vbaexpress.com/kb/getarticle.php?kb_id=824


    you may play with below code:

    VB:
    Private Sub CommandButton1_Click() 
         
        With Worksheets("Data Base") 
             'http://www.ozgrid.com/forum/showthread.php?t=93705
            .AutoFilterMode = False 
            With .Range("A1") 
                .AutoFilter 
                If Len(ComboBox1.Value) > 0 Then 
                    .AutoFilter Field:=1, Criteria1:=ComboBox1.Value 
                End If 
                If Len(ComboBox2.Value) > 0 Then 
                    .AutoFilter Field:=2, Criteria1:=ComboBox2.Value 
                End If 
                If Len(ComboBox3.Value) > 0 Then 
                    .AutoFilter Field:=3, Criteria1:=ComboBox3.Value 
                End If 
                If Len(ComboBox4.Value) > 0 Then 
                    .AutoFilter Field:=4, Criteria1:=ComboBox4.Value 
                End If 
                If Len(ComboBox5.Value) > 0 Then 
                    .AutoFilter Field:=5, Criteria1:=ComboBox5.Value 
                End If 
            End With 
             
             'http://contextures.com/xlautofilter03.html#Copy
             'by Tom Ogilvy
            Dim rng As Range, rng2 As Range 
             
            With .AutoFilter.Range 
                On Error Resume Next 
                Set rng2 = .Offset(1, 0).Resize(.Rows.Count - 1, 1).SpecialCells(xlCellTypeVisible) 
                On Error Goto 0 
            End With 
            If rng2 Is Nothing Then 
                MsgBox "No data to copy" 
            Else 
                Set rng = .AutoFilter.Range 
                 'option1: With headers:
                rng.Copy Destination:=Worksheets("Sheet2").Range("A1") 
                 'option2: without headers:
                 'rng.Offset(1, 0).Resize(rng.Rows.Count - 1).Copy Destination:=Worksheets("Sheet2").Range("A1")
            End If 
            .ShowAllData 
        End With 
         
    End Sub 
    
    
    Formatting tags added by mark007
    "but we ain't singing; we bringing drama."

  3. #3

    please help with this

    Hi, I tried with this code and I came-up with a problem. I only selected a value for combobox2 and then hit command button. Even though there is number of similar records in data base, "no data to copy" message appears.
    What could be the reason for that

  4. #4
    hi.
    that's related with date and percent conversion.

    here's a workaround and a sample file.
    uses five named ranges for 5 criteria:
    Date : Date
    Name : String
    Project: String
    Item: String
    Percentage: Number (formatted as 0%. so change number format of crit in the code to suit your actual data)


    goes to std module:
    VB:
    Sub OpenUF() 
        UserForm1.Show 
    End Sub 
     
    Function UniqueArray(anArray As Variant) As Variant 
         
         'http://www.vbaexpress.com/forum/showthread.php?t=24917
         'Requires, Tools > Reference > Microsoft Scripting Runtime, scrrun.dll
         
        Dim d As New Scripting.Dictionary, a As Variant 
         
        With d 
            .CompareMode = TextCompare 
            For Each a In anArray 
                If Not Len(a) = 0 And Not .Exists(a) Then 
                    .Add a, CStr(a) 'Nothing
                End If 
            Next a 
            UniqueArray = d.keys 
        End With 
         
        Set d = Nothing 
         
    End Function 
    
    
    Formatting tags added by mark007

    goes to userform's code module
    VB:
    Option Explicit 
     
    Dim FArray() 
    Dim DataList As Range 
    Dim MyList As String 
    Dim dDate As Date 
     
    Private Sub UserForm_Initialize() 
         
         'rDate
        MyList = "rDate" 
        Set DataList = Range(MyList) 
        FArray = DataList.Value 
        FArray = UniqueArray(FArray) 
        Call BubbleSort(FArray) 
        ComboBox1.List() = FArray 
         
         'rName
        MyList = "rName" 
        Set DataList = Range(MyList) 
        FArray = DataList.Value 
        FArray = UniqueArray(FArray) 
        Call BubbleSort(FArray) 
        ComboBox2.List() = FArray 
         
         'rProj
        MyList = "rProj" 
        Set DataList = Range(MyList) 
        Set DataList = Range(MyList) 
        FArray = DataList.Value 
        FArray = UniqueArray(FArray) 
        Call BubbleSort(FArray) 
        ComboBox3.List() = FArray 
         
         'rItem
        MyList = "rItem" 
        Set DataList = Range(MyList) 
        FArray = DataList.Value 
        FArray = UniqueArray(FArray) 
        Call BubbleSort(FArray) 
        ComboBox4.List() = FArray 
         
         'rPerc
        MyList = "rPerc" 
        Set DataList = Range(MyList) 
        FArray = DataList.Value 
        FArray = UniqueArray(FArray) 
        Call BubbleSort(FArray) 
        ComboBox5.List() = FArray 
         
    End Sub 
     
     
    Private Sub CommandButton1_Click() 
         
        Dim rng As Range, rng2 As Range 
         
        With Worksheets("Data Base") 
             'http://www.ozgrid.com/forum/showthread.php?t=93705
            .AutoFilterMode = False 
            With .Range("A1") 
                .AutoFilter 
                If Len(ComboBox1.Value) > 0 Then 
                    If IsDate(ComboBox1.Value) Then 
                        dDate = DateSerial(Year(ComboBox1.Value), Month(ComboBox1.Value), Day(ComboBox1.Value)) 
                    End If 
                    .AutoFilter Field:=1, Criteria1:="=" & dDate 
                End If 
                If Len(ComboBox2.Value) > 0 Then .AutoFilter Field:=2, Criteria1:=ComboBox2.Value 
                If Len(ComboBox3.Value) > 0 Then .AutoFilter Field:=3, Criteria1:=ComboBox3.Value 
                If Len(ComboBox4.Value) > 0 Then .AutoFilter Field:=4, Criteria1:=ComboBox4.Value 
                If Len(ComboBox5.Value) > 0 Then .AutoFilter Field:=5, Criteria1:="=" & Format(ComboBox5.Value, "0%") 
            End With 
             'http://contextures.com/xlautofilter03.html#Copy
             'by Tom Ogilvy
            With .AutoFilter.Range 
                On Error Resume Next 
                Set rng2 = .Offset(1, 0).Resize(.Rows.Count - 1, 1).SpecialCells(xlCellTypeVisible) 
                On Error Goto 0 
            End With 
            If rng2 Is Nothing Then 
                MsgBox "No data to copy" 
            Else 
                Worksheets("Sheet2").Cells.Clear 
                Set rng = .AutoFilter.Range 
                 'option1: With headers:
                rng.Copy Destination:=Worksheets("Sheet2").Range("A1") 
                 'option2: without headers:
                 'rng.Offset(1, 0).Resize(rng.Rows.Count - 1).Copy Destination:=Worksheets("Sheet2").Range("A1")
            End If 
            .AutoFilterMode = False 
        End With 
         
    End Sub 
     
     
    Private Sub CommandButton2_Click() 
        Unload Me 
    End Sub 
     
     
    Sub BubbleSort(MyArray As Variant) 
         
        Dim First As Integer 
        Dim Last As Integer 
        Dim i As Integer 
        Dim j As Integer 
        Dim temp As String 
        Dim List As String 
         
        First = LBound(MyArray) 
        Last = UBound(MyArray) 
        For i = First To Last - 1 
            For j = i + 1 To Last 
                If MyArray(i) > MyArray(j) Then 
                    temp = MyArray(j) 
                    MyArray(j) = MyArray(i) 
                    MyArray(i) = temp 
                End If 
            Next j 
        Next i 
    End Sub 
    
    
    Formatting tags added by mark007
    Attached Files Attached Files
      To view attachments your post count must be 0 or greater. Your post count is 0 momentarily.
    "but we ain't singing; we bringing drama."

  5. #5

    Hi mancubus

    Thanks for the reply and now I am getting an error. it says
    "Run time error '1004:
    Method 'Range' of object'_Global' failed "

    What could be the reason for that? Sorry for bothering you. I am extremely new to the VB coding and I am still learning. I Paste my codes for your information.. It will be easy for you to find the error.
    Thanks again and appreciate your help.



    ===============my userform2 code as fallows====================

    VB:
    Option Explicit 
     
    Dim FArray() 
    Dim DataList As Range 
    Dim MyList As String 
    Dim dDate As Date 
     
     
     'combo box
    Private Sub UserForm_Initialize() 
         'Macro Purpose: To populate a combobox with data from
         '               a worksheet range
         
        Dim cbtarget As MSForms.ComboBox 
         
        Dim rngSource As Range 
         
         
         'Set reference to the range of data to be filled
         'Set rngSource = Worksheets("Sheet4").Range("A1:A15")
         'Set rngSource = Workbooks("test.xlsx").Worksheets("Data Base").Range("b:b")
        Set rngSource = Worksheets("Data Base").Range("b:b") 
         
         
         'Fill the listbox
        Set cbtarget = Me.ComboBox1 
        With cbtarget 
             'Insert the range of data supplied
            .List = rngSource.Cells.Value 
             '--------------------------------------------------
             
            Dim cbtarget2 As MSForms.ComboBox 
            Dim rngSource2 As Range 
             'Set rngSource2 = Workbooks("test.xlsx").Worksheets("item").Range("a:a")
            Set rngSource2 = Worksheets("item").Range("a:a") 
             
             'Fill the listbox
            Set cbtarget2 = Me.ComboBox2 
            With cbtarget2 
                 'Insert the range of data supplied
                .List = rngSource2.Cells.Value 
            End With 
             
             
             '--------------------------------------------------
             
            Dim cbtarget3 As MSForms.ComboBox 
            Dim rngSource3 As Range 
             'Set rngSource3 = Workbooks("test.xlsx").Worksheets("item").Range("b:b")
            Set rngSource3 = Worksheets("item").Range("b:b") 
             
             'Fill the listbox
            Set cbtarget3 = Me.ComboBox3 
            With cbtarget3 
                 'Insert the range of data supplied
                .List = rngSource3.Cells.Value 
            End With 
             
             '--------------------------------------------------
             
            Dim cbtarget4 As MSForms.ComboBox 
            Dim rngSource4 As Range 
             'Set rngSource4 = Workbooks("test.xlsx").Worksheets("item").Range("c:c")
            Set rngSource4 = Worksheets("item").Range("c:c") 
             
             'Fill the listbox
            Set cbtarget4 = Me.ComboBox4 
            With cbtarget4 
                 'Insert the range of data supplied
                .List = rngSource4.Cells.Value 
            End With 
             
             
             '--------------------------------------------------
             
            Dim cbtarget5 As MSForms.ComboBox 
            Dim rngSource5 As Range 
             'Set rngSource5 = Workbooks("test.xlsx").Worksheets("item").Range("d:d")
            Set rngSource5 = Worksheets("item").Range("d:d") 
             
             'Fill the listbox
            Set cbtarget5 = Me.ComboBox5 
            With cbtarget5 
                 'Insert the range of data supplied
                .List = rngSource5.Cells.Value 
            End With 
        End With 
         
         
         'by mancubus
         
         'rDate
        MyList = "rDate" 
        Set DataList = Range(MyList) 
        FArray = DataList.Value 
        FArray = UniqueArray(FArray) 
        Call BubbleSort(FArray) 
        ComboBox1.List() = FArray 
         
         'rName
        MyList = "rName" 
        Set DataList = Range(MyList) 
        FArray = DataList.Value 
        FArray = UniqueArray(FArray) 
        Call BubbleSort(FArray) 
        ComboBox2.List() = FArray 
         
         'rProj
        MyList = "rProj" 
        Set DataList = Range(MyList) 
        Set DataList = Range(MyList) 
        FArray = DataList.Value 
        FArray = UniqueArray(FArray) 
        Call BubbleSort(FArray) 
        ComboBox3.List() = FArray 
         
         'rItem
        MyList = "rItem" 
        Set DataList = Range(MyList) 
        FArray = DataList.Value 
        FArray = UniqueArray(FArray) 
        Call BubbleSort(FArray) 
        ComboBox4.List() = FArray 
         
         'rPerc
        MyList = "rPerc" 
        Set DataList = Range(MyList) 
        FArray = DataList.Value 
        FArray = UniqueArray(FArray) 
        Call BubbleSort(FArray) 
        ComboBox5.List() = FArray 
         
    End Sub 
     
     
    Private Sub CommandButton1_Click() 
         
        Dim rng As Range, rng2 As Range 
         
        With Worksheets("Data Base") 
             
            .AutoFilterMode = False 
            With .Range("A1") 
                .AutoFilter 
                If Len(ComboBox1.Value) > 0 Then 
                    If IsDate(ComboBox1.Value) Then 
                        dDate = DateSerial(Year(ComboBox1.Value), Month(ComboBox1.Value), Day(ComboBox1.Value)) 
                    End If 
                    .AutoFilter Field:=1, Criteria1:="=" & dDate 
                End If 
                If Len(ComboBox2.Value) > 0 Then .AutoFilter Field:=2, Criteria1:=ComboBox2.Value 
                If Len(ComboBox3.Value) > 0 Then .AutoFilter Field:=3, Criteria1:=ComboBox3.Value 
                If Len(ComboBox4.Value) > 0 Then .AutoFilter Field:=4, Criteria1:=ComboBox4.Value 
                If Len(ComboBox5.Value) > 0 Then .AutoFilter Field:=5, Criteria1:="=" & Format(ComboBox5.Value, "0%") 
            End With 
             
             'by Tom Ogilvy
            With .AutoFilter.Range 
                On Error Resume Next 
                Set rng2 = .Offset(1, 0).Resize(.Rows.Count - 1, 1).SpecialCells(xlCellTypeVisible) 
                On Error Goto 0 
            End With 
            If rng2 Is Nothing Then 
                MsgBox "No data to copy" 
            Else 
                Worksheets("Sheet2").Cells.Clear 
                Set rng = .AutoFilter.Range 
                 'option1: With headers:
                rng.Copy Destination:=Worksheets("Sheet2").Range("A1") 
                 'option2: without headers:
                 'rng.Offset(1, 0).Resize(rng.Rows.Count - 1).Copy Destination:=Worksheets("Sheet2").Range("A1")
            End If 
            .AutoFilterMode = False 
        End With 
         
    End Sub 
     
     
    Private Sub CommandButton2_Click() 
        Unload Me 
    End Sub 
     
     
    Sub BubbleSort(MyArray As Variant) 
         
        Dim First As Integer 
        Dim Last As Integer 
        Dim i As Integer 
        Dim j As Integer 
        Dim temp As String 
        Dim List As String 
         
        First = LBound(MyArray) 
        Last = UBound(MyArray) 
        For i = First To Last - 1 
            For j = i + 1 To Last 
                If MyArray(i) > MyArray(j) Then 
                    temp = MyArray(j) 
                    MyArray(j) = MyArray(i) 
                    MyArray(i) = temp 
                End If 
            Next j 
        Next i 
    End Sub 
    
    
    Formatting tags added by mark007


    ============my module code as follows=========================

    VB:
    Sub Button4_Click() 
        UserForm2.Show 
         
    End Sub 
     
     
    Function UniqueArray(anArray As Variant) As Variant 
         
         
         'Requires, Tools > Reference > Microsoft Scripting Runtime, scrrun.dll
         
        Dim d As New Scripting.Dictionary, a As Variant 
         
        With d 
            .CompareMode = TextCompare 
            For Each a In anArray 
                If Not Len(a) = 0 And Not .Exists(a) Then 
                    .Add a, CStr(a) 'Nothing
                End If 
            Next a 
            UniqueArray = d.keys 
        End With 
         
        Set d = Nothing 
         
    End Function 
    
    
    Formatting tags added by mark007
    Last edited by xld; 04-03-2012 at 01:04 AM. Reason: Added VBA tags

  6. #6
    i was not able to duplicate your problem.

    can you post your workbook.

    (minimum post count must be at leat 5, i think, to upload a file.)

    ps: post your code within vba tags please.
    pps: did you test the file i posted?
    "but we ain't singing; we bringing drama."

  7. #7

  8. #8

  9. #9

    This is my workbook

    Actually I wanted to create form for Add Data (Data should be saved in another workbook. ) and a Query form.

    Zip file is more than 1mb , so I uploaded my file to rapidshare and here is the link (https://rapidshare.com/files/3477359884/Book1.zip).



    https://rapidshare.com/files/3477359884/Book1.zip

    Thanks

  10. #10
    ok. but we dont have access to rapid in the office.

    you may unpload the file with 20-30 rows of data to help understand the data types in the columns.
    "but we ain't singing; we bringing drama."

  11. #11
    I think this is what you want. I tried to send you my workbook. But I couldn't reduce the file size. If you can send me your email (trough private message), then I can send you my workbook. It may be very helpful to you to figure out the problem easily.
    Thanks



    VB:
     '===========my userform2 code as fallows====================
     
    Option Explicit 
     
    Dim FArray() 
    Dim DataList As Range 
    Dim MyList As String 
    Dim dDate As Date 
     
     
     'combo box
    Private Sub UserForm_Initialize() 
         'Macro Purpose: To populate a combobox with data from
         ' a worksheet range
         
        Dim cbtarget As MSForms.ComboBox 
         
        Dim rngSource As Range 
         
         
         'Set reference to the range of data to be filled
         'Set rngSource = Worksheets("Sheet4").Range("A1:A15")
         'Set rngSource = Workbooks("test.xlsx").Worksheets("Data Base").Range("b:b")
        Set rngSource = Worksheets("Data Base").Range("b:b") 
         
         
         'Fill the listbox
        Set cbtarget = Me.ComboBox1 
        With cbtarget 
             'Insert the range of data supplied
            .List = rngSource.Cells.Value 
             '--------------------------------------------------
             
            Dim cbtarget2 As MSForms.ComboBox 
            Dim rngSource2 As Range 
             'Set rngSource2 = Workbooks("test.xlsx").Worksheets("item").Range("a:a")
            Set rngSource2 = Worksheets("item").Range("a:a") 
             
             'Fill the listbox
            Set cbtarget2 = Me.ComboBox2 
            With cbtarget2 
                 'Insert the range of data supplied
                .List = rngSource2.Cells.Value 
            End With 
             
             
             '--------------------------------------------------
             
            Dim cbtarget3 As MSForms.ComboBox 
            Dim rngSource3 As Range 
             'Set rngSource3 = Workbooks("test.xlsx").Worksheets("item").Range("b:b")
            Set rngSource3 = Worksheets("item").Range("b:b") 
             
             'Fill the listbox
            Set cbtarget3 = Me.ComboBox3 
            With cbtarget3 
                 'Insert the range of data supplied
                .List = rngSource3.Cells.Value 
            End With 
             
             '--------------------------------------------------
             
            Dim cbtarget4 As MSForms.ComboBox 
            Dim rngSource4 As Range 
             'Set rngSource4 = Workbooks("test.xlsx").Worksheets("item").Range("c:c")
            Set rngSource4 = Worksheets("item").Range("c:c") 
             
             'Fill the listbox
            Set cbtarget4 = Me.ComboBox4 
            With cbtarget4 
                 'Insert the range of data supplied
                .List = rngSource4.Cells.Value 
            End With 
             
             
             '--------------------------------------------------
             
            Dim cbtarget5 As MSForms.ComboBox 
            Dim rngSource5 As Range 
             'Set rngSource5 = Workbooks("test.xlsx").Worksheets("item").Range("d:d")
            Set rngSource5 = Worksheets("item").Range("d:d") 
             
             'Fill the listbox
            Set cbtarget5 = Me.ComboBox5 
            With cbtarget5 
                 'Insert the range of data supplied
                .List = rngSource5.Cells.Value 
            End With 
        End With 
         
         
         'by mancubus
         
         'rDate
        MyList = "rDate" 
        Set DataList = Range(MyList) 
        FArray = DataList.Value 
        FArray = UniqueArray(FArray) 
        Call BubbleSort(FArray) 
        ComboBox1.List() = FArray 
         
         'rName
        MyList = "rName" 
        Set DataList = Range(MyList) 
        FArray = DataList.Value 
        FArray = UniqueArray(FArray) 
        Call BubbleSort(FArray) 
        ComboBox2.List() = FArray 
         
         'rProj
        MyList = "rProj" 
        Set DataList = Range(MyList) 
        Set DataList = Range(MyList) 
        FArray = DataList.Value 
        FArray = UniqueArray(FArray) 
        Call BubbleSort(FArray) 
        ComboBox3.List() = FArray 
         
         'rItem
        MyList = "rItem" 
        Set DataList = Range(MyList) 
        FArray = DataList.Value 
        FArray = UniqueArray(FArray) 
        Call BubbleSort(FArray) 
        ComboBox4.List() = FArray 
         
         'rPerc
        MyList = "rPerc" 
        Set DataList = Range(MyList) 
        FArray = DataList.Value 
        FArray = UniqueArray(FArray) 
        Call BubbleSort(FArray) 
        ComboBox5.List() = FArray 
         
    End Sub 
     
     
    Private Sub CommandButton1_Click() 
         
        Dim rng As Range, rng2 As Range 
         
        With Worksheets("Data Base") 
             
            .AutoFilterMode = False 
            With .Range("A1") 
                .AutoFilter 
                If Len(ComboBox1.Value) > 0 Then 
                    If IsDate(ComboBox1.Value) Then 
                        dDate = DateSerial(Year(ComboBox1.Value), Month(ComboBox1.Value), Day(ComboBox1.Value)) 
                    End If 
                    .AutoFilter Field:=1, Criteria1:="=" & dDate 
                End If 
                If Len(ComboBox2.Value) > 0 Then .AutoFilter Field:=2, Criteria1:=ComboBox2.Value 
                If Len(ComboBox3.Value) > 0 Then .AutoFilter Field:=3, Criteria1:=ComboBox3.Value 
                If Len(ComboBox4.Value) > 0 Then .AutoFilter Field:=4, Criteria1:=ComboBox4.Value 
                If Len(ComboBox5.Value) > 0 Then .AutoFilter Field:=5, Criteria1:="=" & Format(ComboBox5.Value, "0%") 
            End With 
             
             'by Tom Ogilvy
            With .AutoFilter.Range 
                On Error Resume Next 
                Set rng2 = .Offset(1, 0).Resize(.Rows.Count - 1, 1).SpecialCells(xlCellTypeVisible) 
                On Error Goto 0 
            End With 
            If rng2 Is Nothing Then 
                MsgBox "No data to copy" 
            Else 
                Worksheets("Sheet2").Cells.Clear 
                Set rng = .AutoFilter.Range 
                 'option1: With headers:
                rng.Copy Destination:=Worksheets("Sheet2").Range("A1") 
                 'option2: without headers:
                 'rng.Offset(1, 0).Resize(rng.Rows.Count - 1).Copy Destination:=Worksheets("Sheet2").Range("A1")
            End If 
            .AutoFilterMode = False 
        End With 
         
    End Sub 
     
     
    Private Sub CommandButton2_Click() 
        Unload Me 
    End Sub 
     
     
    Sub BubbleSort(MyArray As Variant) 
         
        Dim First As Integer 
        Dim Last As Integer 
        Dim i As Integer 
        Dim j As Integer 
        Dim temp As String 
        Dim List As String 
         
        First = LBound(MyArray) 
        Last = UBound(MyArray) 
        For i = First To Last - 1 
            For j = i + 1 To Last 
                If MyArray(i) > MyArray(j) Then 
                    temp = MyArray(j) 
                    MyArray(j) = MyArray(i) 
                    MyArray(i) = temp 
                End If 
            Next j 
        Next i 
    End Sub 
     
     
     
     
     '============my module code as follows=========================
     'module 10
    Sub Button4_Click() 
        UserForm2.Show 
         
    End Sub 
     
     
    Function UniqueArray(anArray As Variant) As Variant 
         
         
         'Requires, Tools > Reference > Microsoft Scripting Runtime, scrrun.dll
         
        Dim d As New Scripting.Dictionary, a As Variant 
         
        With d 
            .CompareMode = TextCompare 
            For Each a In anArray 
                If Not Len(a) = 0 And Not .Exists(a) Then 
                    .Add a, CStr(a) 'Nothing
                End If 
            Next a 
            UniqueArray = d.keys 
        End With 
         
        Set d = Nothing 
    End Function 
     
     '-------------Module1
     
    Sub ShowIt() 
         
        Calendar.Show 
         
    End Sub 
     
     '-----------Module9
    
    
    Formatting tags added by mark007

  12. #12
    ok. im home and downloaded your file.

    your file is too large because you created excel tables from entire columns.

    file is attached.

    UF5 is my thing.

    tested and its working.


    ps: same file. i only converted tables to ranges. see the diffrence in sizes.
    Attached Files Attached Files
      To view attachments your post count must be 0 or greater. Your post count is 0 momentarily.
    "but we ain't singing; we bringing drama."

  13. #13
    Hi,
    Again I got following problem. Sorry for bothering you...


    Userform5- when I try to filter data with Date , it says "no data to copy" even though there are some records in the database .


    I have one more thing to clarify:
    I want to keep data entry form,filter form separate workbook (let say workbook1) and the all the other things (Data base sheet and Item sheet) in another workbook (let say workbook2). As I learnt last couple of days,

    Set rngSource = Worksheets("item").Range("c2:c1048576") should be changed to
    Set rngSource = Workbooks("workbook2").Worksheets("item").Range("c2:c1048576").

    But the problem is, I have to open both file to work with forms. I don't want to open workbook2. As I understand there are no way other than opening workbook2. I think the best way to do it, when the forms open, workbook should open automatically, but workbook should not appears to the user(need to hide from the user). What do you think? Problem is I don't know the code for that. I tried to find. but I couldn't.
    Could you please tell me the solution for that.




    VB:
     'to enter data into another workbook
     
    Set rngSource = Worksheets("item").Range("c2:c1048576") 
     'should be changed to
    Set rngSource = Workbooks("bookname").Worksheets("item").Range("c2:c1048576"). 
    
    
    Formatting tags added by mark007

  14. #14
    I Updated...

    Thanks to sharing........

  15. #15
    For the issue where you get the pop up "no data to copy"
    You might try this trick I got from Xld to deal with different regional settings.

    Change this line:
    VB:
    dDate = DateSerial(Year(ComboBox1.Value), Month(ComboBox1.Value), Day(ComboBox1.Value)) 
    
    
    Formatting tags added by mark007
    To this:
    VB:
     
    dDate = Format(DateSerial(Year(ComboBox1.Value), Month(ComboBox1.Value), _ 
    Day(ComboBox1.Value)), Cells(2, 2).NumberFormat) 
    
    
    Formatting tags added by mark007

  16. #16
    Hi Frank,
    I changed the code as you said. but it doesnt work for me

  17. #17
    see attached files. one is for data base, the other is for data entry and filtering

    tested and it works.

    after entering data or filtering DataBaseFile is closed. reopen to see the results.
    Attached Files Attached Files
      To view attachments your post count must be 0 or greater. Your post count is 0 momentarily.
    "but we ain't singing; we bringing drama."

  18. #18
    dbfile
    Attached Files Attached Files
      To view attachments your post count must be 0 or greater. Your post count is 0 momentarily.
    "but we ain't singing; we bringing drama."

  19. #19
    Quote Originally Posted by mancubus
    dbfile
    Hi mancubus,

    Thank you very much for the project. It works brilliantly (except the "date" filter , when I try to search using a date..it always says "no data to copy" ). Could you please check it again for me.

    Thank you very much again.

  20. #20
    you're wellcome hussy.

    you should play with date filter...

    VB:
    Dim dDate As Date 
    Dim lDate As Long 
     
     
    If Len(ComboBox1.Value) > 0 Then 
        If IsDate(ComboBox1.Value) Then 
            dDate = DateSerial(Year(ComboBox1.Value), Month(ComboBox1.Value), _ 
            Day(ComboBox1.Value)) 
            lDate = dDate 
        End If 
        .AutoFilter Field:=2, Criteria1:="=" & lDate 
    End If 
    
    
    Formatting tags added by mark007

    another approach could be...

    VB:
    Dim lDate As Long 
     
     
    If Len(ComboBox1.Value) > 0 Then 
        If IsDate(ComboBox1.Value) Then 
            lDate = CLng(DateValue(ComboBox1.Value)) 
        End If 
        .AutoFilter Field:=2, Criteria1:="=" & lDate 
    End If 
    
    
    Formatting tags added by mark007
    "but we ain't singing; we bringing drama."

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •