Thread: Sort and print based on Cell Value

Hello James.

What will trigger the appearance of this input box?

Hello James,

This macro looks at the data on "Sheet1" and creates a report on "Sheet2". A report sheet has to be used for printing. If all the cells aren't contiguous, a new sheet will be printed where the rows break. You can change the worksheet names and starting cells. They are marked in red. It is assumed each worksheet has a header row. If you aren't using a header row, let me know. The sorting routine may not work correctly if there is no header.

Code:

Sub Macro1()

  Dim Answer As Integer
  Dim BuyCount As Long
  Dim Cell As Range
  Dim DataRng As Range
  Dim LastColumn As Long
  Dim LastRow As Long
  Dim R As Long
  Dim ReportRng As Range
  Dim RngEnd As Range
  
   'Initialize the data and report ranges
    Set DataRng = Worksheets("Sheet1").Range("A2")
    Set ReportRng = Worksheets("Sheet2").Range("A2")
    
   'Find the last row of the data
    Set RngEnd = DataRng.Parent.Cells(Rows.Count, DataRng.Column).End(xlUp)
    Set DataRng = IIf(RngEnd.Row < DataRng.Row, DataRng, DataRng.Parent.Range(DataRng, RngEnd))
    
   'Find the last column on the data range worksheet
    LastColumn = Cells.Find("*", , xlFormulas, xlWhole, xlByColumns, xlPrevious, False).Column
    
   'Find the last row of the report worksheet
    LastRow = ReportRng.Parent.Cells.Find("*", , xlFormulas, xlWhole, xlByRows, xlPrevious, False).Row
    LastRow = IIf(LastRow < ReportRng.Row, ReportRng.Row, LastRow)
    
     'Count the cells with "buy" in them
      For Each Cell In DataRng
        If LCase(Trim(Cell)) = "buy" Then
           BuyCount = BuyCount + 1
        End If
      Next Cell
      
     'Exit if ther aren't any matches
      If BuyCount > 0 Then
         Answer = MsgBox("There are " & Str(BuyCount) _
                & " alerts. Do you want a report?", _
                  vbInformation + vbYesNo)
         If Answer = vbYes Then
           'Sort ascending using Column "B"
            Set DataRng = DataRng.Offset(0, 1)
            DataRng.Sort Key1:=DataRng.Cells(1, 1), Order1:=xlAscending, _
                     Header:=xlYes, Orientation:=xlSortRows
           'Copy the rows if column "A" equals "buy" over to the Report worksheet
            Set DataRng = DataRng.Offset(0, -1)
            Set Cell = DataRng.Find("buy", , xlFormulas, xlWhole, xlByRows, xlNext, False)
            Set DataRng = DataRng.Resize(Cell.Row + BuyCount - 1, LastColumn)
           'Clear any previous reports
            With ReportRng.Parent
              .Range(ReportRng, .Cells(LastRow, .Columns.Count)).ClearContents
            End With
              For Each Cell In DataRng
                If LCase(Trim(Cell)) = "buy" Then
                   Cell.EntireRow.Copy ReportRng.Offset(R, 0)
                   R = R + 1
                End If
              Next Cell
           'Print the report
            ReportRng.Parent.UsedRange.PrintOut
         End If
      End If
     
 End Sub

Adding the Macro
1. Copy the macro above pressing the keys CTRL+C
2. Open your workbook
3. Press the keys ALT+F11 to open the Visual Basic Editor
4. Press the keys ALT+I to activate the Insert menu
5. Press M to insert a Standard Module
6. Paste the code by pressing the keys CTRL+V
7. Make any custom changes to the macro if needed at this time.
8. Save the Macro by pressing the keys CTRL+S
9. Press the keys ALT+Q to exit the Editor, and return to Excel.

To Run the Macro...
To run the macro from Excel, open the workbook, and press ALT+F8 to display the Run Macro Dialog. Double Click

the macro's name to Run it.