Private Sub CommandButton2_Click() Dim i As Long Dim lastRow As Long Dim rRow As Long, cCol As Long Dim TxnDate As Date Dim rng As Range Dim wb1 As Workbook '~~> Change the range to the relevant range here If Intersect(Selection, Range("u20:u29")) Is Nothing Then 'the intersect function checks to see if the selection exists in the given range MsgBox "Please select the cell in the correct range" Exit Sub End If Application.ScreenUpdating = False 'By setting ScreenUpdating to False at the Start of the macro, you will not only stop ' the constant screen flickering associated with recorded macro, but also greatly speed ' up the execution of the macro. The reason it speeds up code is because Excel no longer ' needs to repaint the screen whenever it encounters such commands as Select, Activate, ' LargeScroll, SmallScroll and many others. lastRow = Sheets("IssuedChecks").Range("A" & Rows.Count).End(xlUp).Row ' finds last row in IssuedChecks Worksheet MsgBox ("The last row is: " & lastRow) 'This part tells the macro which row/date we are looking for rRow = Selection.Row MsgBox ("The current row is: " & rRow) TxnDate = Cells(rRow, 20).Value MsgBox ("We are looking for " & TxnDate) 'Creating new table in memory? Set rng = Sheets("IssuedChecks").Range("A1:J1") For i = 2 To lastRow If Sheets("IssuedChecks").Range("c" & i).Value = TxnDate Then Set rng = Union(rng, Sheets("IssuedChecks").Range("A" & i & ":J" & i)) 'if the date matches, add this column to the open workbook End If Next i rng.Copy Set wb1 = Workbooks.Add wb1.Sheets(1).Activate ActiveSheet.Paste '~~> Change the file Name Here 'wb1.SaveAs "\\adpsfs\Accounting\Bobby\MyFile.xls" Call fitWidth Application.CutCopyMode = False Application.ScreenUpdating = True End Sub
Join the community of 500,000 technology professionals and ask your questions.
Connect with top rated Experts
20 Experts available now in Live!