Ok Everyone,
You have helped this novice before, and I have been searching through the forum for some time now to find how to do this. Basically as an accountant for a school I run a TON of queries that have a variety of information. There are mutiple fund sources involved and I need to move all but one source to the bottom (insert lines to seperate the top source from the rest). I am in need of some code that will find the other sources, cut them, and paste them at the bottom. The tricky part is that every query has a variety of rows so I never know what the last row is. Below is some code that I obtained from a previous accountant and from the record macro function, but it only moves the "STATE" source to the bottom and there are still a handful of sources that remain and need to be moved. Any advice would be appreciated. Also if any changes to the current code can be simplified please let me know.
Sub Example()
'
' Example Macro
'
' Keyboard Shortcut: Ctrl+Shift+C
'
'Asking for the Sheet name of the workbook to avoid errors
sheetName = InputBox("Please enter the name (case-sensitive) of" & Chr(10) & "the first sheet in the workbook (e.g. Sheet1): ")
'Deleting the first row and also checking for errors in the sheetName variable before any action is taken
Worksheets(sheetName).Activate
Rows("1:1").Select
Selection.Delete Shift:=xlUp
'Changing Font to Times New Roman
Cells.Select
With Selection.Font
.Name = "Times New Roman"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
.TintAndShade = 0
.ThemeFont = xlThemeFontNone
End With
'Fitting all the columns
Columns("A:A").EntireColumn.AutoFit
Columns("B:B").EntireColumn.AutoFit
Columns("C:C").EntireColumn.AutoFit
Columns("D:D").EntireColumn.AutoFit
Columns("E:E").EntireColumn.AutoFit
Columns("F:F").EntireColumn.AutoFit
Columns("G:G").EntireColumn.AutoFit
Columns("H:H").EntireColumn.AutoFit
Columns("I:I").EntireColumn.AutoFit
Columns("J:J").EntireColumn.AutoFit
Columns("K:K").EntireColumn.AutoFit
Columns("L:L").EntireColumn.AutoFit
Columns("M:M").EntireColumn.AutoFit
Columns("N:N").EntireColumn.AutoFit
Columns("O:O").EntireColumn.AutoFit
Columns("P:P").EntireColumn.AutoFit
Columns("Q:Q").EntireColumn.AutoFit
Columns("R:R").EntireColumn.AutoFit
Columns("S:S").EntireColumn.AutoFit
Columns("T:T").EntireColumn.AutoFit
'This sorts all the data by "Fund" (Column E) "Bud Cat" (Column D) and by "Date" (Column B)
ActiveWorkbook.Worksheets(sheetName).Sort.SortFields.Clear
ActiveWorkbook.Worksheets(sheetName).Sort.SortFields.Add Key:=Range("E2:E10000") _
, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
ActiveWorkbook.Worksheets(sheetName).Sort.SortFields.Add Key:=Range("D2:D10000") _
, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
ActiveWorkbook.Worksheets(sheetName).Sort.SortFields.Add Key:=Range("B2:B10000") _
, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets(sheetName).Sort
.SetRange Range("A1:U10000")
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
'This finds where the State section starts and adds rows above it
Range("E1").Select
For i = 1 To 10000
ActiveCell.Offset(1, 0).Select
If ActiveCell.Value = "STATE" Then Exit For
Next i
'Adding rows
Rows(ActiveCell.Row).Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
'This copies the first row and pastes it above the "State" section
Rows("1:1").Select
Selection.Copy
Range("E1").Select
For i = 1 To 10000
ActiveCell.Offset(1, 0).Select
If ActiveCell.Value = "STATE" Then Exit For
Next i
Rows(ActiveCell.Row).Offset(-1, 0).Select
ActiveSheet.Paste
Range("A2").Select
Selection.Subtotal GroupBy:=4, Function:=xlSum, TotalList:=Array(20), _
Replace:=True, PageBreaks:=False, SummaryBelowData:=True
ActiveSheet.Outline.ShowLevels RowLevels:=2
ActiveWindow.SmallScroll Down:=-21
ActiveCell.Offset(28, 4).Range("A1").Select
'Finally, this puts a comma in the S Column
Range("T1:T10000").Select
Selection.style = "Comma"
'Just selecting the first cell in the workbook to end on
Range("A1").Select
End Sub
Bookmarks