Consulting

Results 1 to 20 of 20

Thread: userform search

  1. #1
    VBAX Regular
    Joined
    Mar 2012
    Posts
    13
    Location

    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
    VBAX Guru mancubus's Avatar
    Joined
    Dec 2010
    Location
    "Where I lay my head is home" :D
    Posts
    2,644
    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:

    [VBA]
    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
    [/VBA]
    PLS DO NOT PM; OPEN A THREAD INSTEAD!!!

    1) Posting Code
    [CODE]PasteYourCodeHere[/CODE]
    (or paste your code, select it, click # button)

    2) Uploading File(s)
    Go Advanced / Attachments - Manage Attachments / Add Files / Select Files / Select the file(s) (multiple files can be selected while holding Ctrl key) / Upload Files / Done
    Replace company specific / sensitive / confidential data. Include so many rows and sheets etc in the uploaded workbook to enable the helpers visualize the data and table structure. Helpers do not need the entire workbook.

    3) Testing the Codes
    always back up your files before testing the codes.

    4) Marking the Thread as Solved
    from Thread Tools (on the top right corner, above the first message)

  3. #3
    VBAX Regular
    Joined
    Mar 2012
    Posts
    13
    Location

    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
    VBAX Guru mancubus's Avatar
    Joined
    Dec 2010
    Location
    "Where I lay my head is home" :D
    Posts
    2,644
    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:
    [VBA]
    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
    [/VBA]


    goes to userform's code module
    [VBA]
    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
    [/VBA]
    Attached Files Attached Files
    PLS DO NOT PM; OPEN A THREAD INSTEAD!!!

    1) Posting Code
    [CODE]PasteYourCodeHere[/CODE]
    (or paste your code, select it, click # button)

    2) Uploading File(s)
    Go Advanced / Attachments - Manage Attachments / Add Files / Select Files / Select the file(s) (multiple files can be selected while holding Ctrl key) / Upload Files / Done
    Replace company specific / sensitive / confidential data. Include so many rows and sheets etc in the uploaded workbook to enable the helpers visualize the data and table structure. Helpers do not need the entire workbook.

    3) Testing the Codes
    always back up your files before testing the codes.

    4) Marking the Thread as Solved
    from Thread Tools (on the top right corner, above the first message)

  5. #5
    VBAX Regular
    Joined
    Mar 2012
    Posts
    13
    Location

    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====================

    [VBA]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
    [/VBA]



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

    [VBA]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[/VBA]
    Last edited by Bob Phillips; 04-03-2012 at 01:04 AM. Reason: Added VBA tags

  6. #6
    VBAX Guru mancubus's Avatar
    Joined
    Dec 2010
    Location
    "Where I lay my head is home" :D
    Posts
    2,644
    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?
    PLS DO NOT PM; OPEN A THREAD INSTEAD!!!

    1) Posting Code
    [CODE]PasteYourCodeHere[/CODE]
    (or paste your code, select it, click # button)

    2) Uploading File(s)
    Go Advanced / Attachments - Manage Attachments / Add Files / Select Files / Select the file(s) (multiple files can be selected while holding Ctrl key) / Upload Files / Done
    Replace company specific / sensitive / confidential data. Include so many rows and sheets etc in the uploaded workbook to enable the helpers visualize the data and table structure. Helpers do not need the entire workbook.

    3) Testing the Codes
    always back up your files before testing the codes.

    4) Marking the Thread as Solved
    from Thread Tools (on the top right corner, above the first message)

  7. #7
    VBAX Regular
    Joined
    Mar 2012
    Posts
    13
    Location
    I ll upload the file

  8. #8
    VBAX Regular
    Joined
    Mar 2012
    Posts
    13
    Location
    1

  9. #9
    VBAX Regular
    Joined
    Mar 2012
    Posts
    13
    Location

    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
    VBAX Guru mancubus's Avatar
    Joined
    Dec 2010
    Location
    "Where I lay my head is home" :D
    Posts
    2,644
    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.
    PLS DO NOT PM; OPEN A THREAD INSTEAD!!!

    1) Posting Code
    [CODE]PasteYourCodeHere[/CODE]
    (or paste your code, select it, click # button)

    2) Uploading File(s)
    Go Advanced / Attachments - Manage Attachments / Add Files / Select Files / Select the file(s) (multiple files can be selected while holding Ctrl key) / Upload Files / Done
    Replace company specific / sensitive / confidential data. Include so many rows and sheets etc in the uploaded workbook to enable the helpers visualize the data and table structure. Helpers do not need the entire workbook.

    3) Testing the Codes
    always back up your files before testing the codes.

    4) Marking the Thread as Solved
    from Thread Tools (on the top right corner, above the first message)

  11. #11
    VBAX Regular
    Joined
    Mar 2012
    Posts
    13
    Location
    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



    [VBA]
    '===========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



    [/VBA]

  12. #12
    VBAX Guru mancubus's Avatar
    Joined
    Dec 2010
    Location
    "Where I lay my head is home" :D
    Posts
    2,644
    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
    PLS DO NOT PM; OPEN A THREAD INSTEAD!!!

    1) Posting Code
    [CODE]PasteYourCodeHere[/CODE]
    (or paste your code, select it, click # button)

    2) Uploading File(s)
    Go Advanced / Attachments - Manage Attachments / Add Files / Select Files / Select the file(s) (multiple files can be selected while holding Ctrl key) / Upload Files / Done
    Replace company specific / sensitive / confidential data. Include so many rows and sheets etc in the uploaded workbook to enable the helpers visualize the data and table structure. Helpers do not need the entire workbook.

    3) Testing the Codes
    always back up your files before testing the codes.

    4) Marking the Thread as Solved
    from Thread Tools (on the top right corner, above the first message)

  13. #13
    VBAX Regular
    Joined
    Mar 2012
    Posts
    13
    Location
    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.




    [VBA]
    '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").
    [/VBA]

  14. #14
    I Updated...

    Thanks to sharing........

  15. #15
    VBAX Expert
    Joined
    Sep 2010
    Posts
    604
    Location
    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:
    [VBA]dDate = DateSerial(Year(ComboBox1.Value), Month(ComboBox1.Value), Day(ComboBox1.Value))
    [/VBA]
    To this:
    [VBA]
    dDate = Format(DateSerial(Year(ComboBox1.Value), Month(ComboBox1.Value), _
    Day(ComboBox1.Value)), Cells(2, 2).NumberFormat)
    [/VBA]

  16. #16
    VBAX Regular
    Joined
    Mar 2012
    Posts
    13
    Location
    Hi Frank,
    I changed the code as you said. but it doesnt work for me

  17. #17
    VBAX Guru mancubus's Avatar
    Joined
    Dec 2010
    Location
    "Where I lay my head is home" :D
    Posts
    2,644
    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
    PLS DO NOT PM; OPEN A THREAD INSTEAD!!!

    1) Posting Code
    [CODE]PasteYourCodeHere[/CODE]
    (or paste your code, select it, click # button)

    2) Uploading File(s)
    Go Advanced / Attachments - Manage Attachments / Add Files / Select Files / Select the file(s) (multiple files can be selected while holding Ctrl key) / Upload Files / Done
    Replace company specific / sensitive / confidential data. Include so many rows and sheets etc in the uploaded workbook to enable the helpers visualize the data and table structure. Helpers do not need the entire workbook.

    3) Testing the Codes
    always back up your files before testing the codes.

    4) Marking the Thread as Solved
    from Thread Tools (on the top right corner, above the first message)

  18. #18
    VBAX Guru mancubus's Avatar
    Joined
    Dec 2010
    Location
    "Where I lay my head is home" :D
    Posts
    2,644
    dbfile
    Attached Files Attached Files
    PLS DO NOT PM; OPEN A THREAD INSTEAD!!!

    1) Posting Code
    [CODE]PasteYourCodeHere[/CODE]
    (or paste your code, select it, click # button)

    2) Uploading File(s)
    Go Advanced / Attachments - Manage Attachments / Add Files / Select Files / Select the file(s) (multiple files can be selected while holding Ctrl key) / Upload Files / Done
    Replace company specific / sensitive / confidential data. Include so many rows and sheets etc in the uploaded workbook to enable the helpers visualize the data and table structure. Helpers do not need the entire workbook.

    3) Testing the Codes
    always back up your files before testing the codes.

    4) Marking the Thread as Solved
    from Thread Tools (on the top right corner, above the first message)

  19. #19
    VBAX Regular
    Joined
    Mar 2012
    Posts
    13
    Location
    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
    VBAX Guru mancubus's Avatar
    Joined
    Dec 2010
    Location
    "Where I lay my head is home" :D
    Posts
    2,644
    you're wellcome hussy.

    you should play with date filter...

    [VBA]
    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
    [/VBA]


    another approach could be...

    [VBA]
    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
    [/VBA]
    PLS DO NOT PM; OPEN A THREAD INSTEAD!!!

    1) Posting Code
    [CODE]PasteYourCodeHere[/CODE]
    (or paste your code, select it, click # button)

    2) Uploading File(s)
    Go Advanced / Attachments - Manage Attachments / Add Files / Select Files / Select the file(s) (multiple files can be selected while holding Ctrl key) / Upload Files / Done
    Replace company specific / sensitive / confidential data. Include so many rows and sheets etc in the uploaded workbook to enable the helpers visualize the data and table structure. Helpers do not need the entire workbook.

    3) Testing the Codes
    always back up your files before testing the codes.

    4) Marking the Thread as Solved
    from Thread Tools (on the top right corner, above the first message)

Posting Permissions

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