Results 1 to 3 of 3
  1. #1
    Join Date
    Jan 2012
    Posts
    1

    Unanswered: Print data for speific date using VBA in Excel

    Hi guys;
    I am new to Excel VBA. I created an user input form to enter data to worksheet. I am trying to find out how to print all rows with today's date or any other specified date. I appreciate if anyone can help.

    regards

  2. #2
    Join Date
    Jan 2002
    Location
    Bay Area
    Posts
    511
    This might be one solution: assuming you are working from Sheet1,
    - add a command button and set its PrintObject property to False so the
    button will not appear on printouts. To set this property, click View,
    Toolbars, Visual Basic, and on this toolbar click the pencil with ruler icon
    to go into design mode, then left-click the mouse on top of the new
    command button and choose Properties, where you can now view and
    change properties, including the button name and caption on the button.
    - add code to the button's click event that will open a form to display
    a list of dates to pick from
    - when a date is selected and a Print button is clicked, the form's Print
    button code sets up an AutoFilter on Sheet1 so that only the heading
    row #1 and rows with the date selected are visible.
    - the form closes and returns control back to code executed by Sheet1
    command button, where the PrintOut is done, and then the filter is
    removed.

    The form's code reads all the dates in column A, starting at Cell A2,
    and stores just unique values in an array. The array is sorted and
    then loaded to a list box. Only one date can be selected.

    An Excel 2003 example of this is attached. Here is the code behind
    the Sheet1 button:
    Code:
    Private Sub cmdReport_Click()
    'display picklist of dates; print report for date selected
        
        'if Sheet1 AutoFilter is in effect, remove it
        If Worksheets("Sheet1").FilterMode = True Then Selection.AutoFilter
        
        Load UserForm1
        UserForm1.Show
        
        If Worksheets("Sheet1").FilterMode = True Then
            'after testing, remove or comment out PrintPreview and remove
            'the quote in front of ...PrintOut
            ActiveWindow.SelectedSheets.PrintPreview
            'ActiveWindow.SelectedSheets.PrintOut
            Selection.AutoFilter        'all done--remove AutoFilter
        End If
        
    End Sub
    and the userform's code:
    Code:
    Private Sub cmdPrint_Click()
    'set up filter to print report if a date was selected
    
        If Me.lstDates.ListIndex < 0 Then
            MsgBox "No date selected...terminating."
        Else
            Application.ScreenUpdating = False
            Range("A1:C1").Select
            Range(Selection, Selection.End(xlDown)).Select
            Selection.AutoFilter Field:=1, Criteria1:=Me.lstDates.List(Me.lstDates.ListIndex)
            Range("A1").Select
         End If
         
         Unload Me
         
    End Sub
    
    Private Sub UserForm_Activate()
    'populate list box with dates from column A
    Dim i As Long, j As Long
    Dim arrayOfDates() As Variant, varDate As Variant, tmp As Variant
    ReDim arrayOfDates(1)
    
        'store a unique list of dates in an array
        i = 2
        Do While Sheets("Sheet1").Cells(i, 1).Value <> ""
            varDate = Sheets("Sheet1").Cells(i, 1).Value
            If isUniqueDate(varDate, arrayOfDates) Then
                arrayOfDates(UBound(arrayOfDates) - 1) = varDate
                ReDim Preserve arrayOfDates(UBound(arrayOfDates) + 1)
            End If
            i = i + 1
        Loop
        
        ReDim Preserve arrayOfDates(UBound(arrayOfDates) - 1) 'discard last array element which is empty
         
        'sort the array in ascending date order
        For i = 0 To (UBound(arrayOfDates) - 1)
            For j = 1 To (UBound(arrayOfDates) - 1)
                If arrayOfDates(j - 1) > arrayOfDates(j) Then
                    tmp = arrayOfDates(j - 1)
                    arrayOfDates(j - 1) = arrayOfDates(j)
                    arrayOfDates(j) = tmp
                End If
            Next
        Next
        
        'populate the list box
        For i = 0 To (UBound(arrayOfDates) - 1)
            Me.lstDates.AddItem arrayOfDates(i)
        Next
    
    End Sub
    
    Function isUniqueDate(dateIn, ByRef arrayOfDates) As Boolean
    'return False if the value of dateIn exists in the array
    Dim k As Integer
    Dim tmpBool As Boolean
    
        tmpBool = True
        For k = 0 To UBound(arrayOfDates)
            If dateIn = arrayOfDates(k) Then
                tmpBool = False
                Exit For
            End If
        Next
    
        isUniqueDate = tmpBool
        
    End Function
    
    Private Sub cmdCancel_Click()
    
        Unload Me
        
    End Sub
    Attached Files Attached Files

  3. #3
    Join Date
    Jan 2002
    Location
    Bay Area
    Posts
    511
    I think it is better to sort the list box of dates in descending order, so if you are
    more likely to be reviewing newer dates than older ones, this code will sort in descending order. Changes to the code are in red font:
    Code:
    'sort the array in descending date order
        For i = (UBound(arrayOfDates) - 1) To 0 Step -1
            For j = 1 To (UBound(arrayOfDates) - 1)
                If arrayOfDates(j - 1) < arrayOfDates(j) Then
                    tmp = arrayOfDates(j - 1)
                    arrayOfDates(j - 1) = arrayOfDates(j)
                    arrayOfDates(j) = tmp
                End If
            Next
        Next
    Last edited by JerryDal; 01-20-12 at 14:33.

Posting Permissions

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