Manage projects of all sizes how you want. Great for personal to-do lists, project milestones, team priorities and launch plans.
- Combine task lists, docs, spreadsheets, and chat in one
- View and edit from mobile/offline
- Cut down on emails
Sub CommandButton1_Click() Dim i As Long, lastRow As Long Dim rRow As Long, cCol As Long Dim mMonth As Long Dim yYear As Long Dim rng As Range Dim wb1 As Workbook Dim Dept As String '~~> Change the range to the relevant range here If Intersect(Selection, Range("r8:u13")) 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 'Sheets("QB_Expenses").Activate lastRow = Sheets("QB_Expenses").Range("A" & Rows.Count).End(xlUp).Row ' finds last row in QB_Expenses Worksheet 'This part tells the macro which dept/month combination we are working with rRow = Selection.Row cCol = Selection.Column mMonth = Month(Cells(7, cCol).Value) 'What month are we looking for? yYear = Year(Cells(7, cCol).Value) 'The month columns are all in row 7 Dept = Cells(rRow, 14).Value 'What Dept are we looking for 'The Departments rows are all in column 14 Set rng = Sheets("QB_Expenses").Range("A1:G1") 'On Error GoTo ErrorCatch For i = 2 To lastRow If Month(Sheets("QB_Expenses").Range("C" & i).Value) = mMonth _ And _ Year(Sheets("QB_Expenses").Range("C" & i).Value) = yYear _ And _ Sheets("QB_Expenses").Range("D" & i).Value = Dept Then Set rng = Union(rng, Sheets("QB_Expenses").Range("A" & i & ":G" & i)) 'if the month, year, and dept match, add this row to the open workbook End If Next i Sheets("QB_Expenses").Range(rng.Address).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
|why using INDIRECT function prompt for " do you want to save changes?" while there is no changes made?||2||15|
|Excel file merge 2 cells with line break||2||23|
|Excel 2016 Hiding Toolbars||7||22|
|Macro to delete column||3||10|
Join the community of 500,000 technology professionals and ask your questions.
Connect with top rated Experts
19 Experts available now in Live!