Suggestions...

[Guest]

Scenario...

Sort by month, extract current month, copy to new sheet and then pivot. So
far, I've only been able to succeed in sorting only. The INput box will come
up, and the new sheet is added, but not the rest. Could someone look this
over and tell me what I'm doing wrong? I haven't gotten to the pivoting this
yet...

Sub MakePivots()
Dim sFile
Dim xlBook As Excel.Workbook
Dim xlSheet1 As Worksheet

'OPEN CURRENT MONTH HIRE REPORT
MsgBox "Open this month's HIRE report", [vbOKOnly]
sFile = Application.GetOpenFilename("Excel Files (*.xls), *.xls")
If sFile <> False Then
End If

Set xlBook = Workbooks.Open(sFile)
Set xlSheet1 = xlBook.Worksheets("YTD")

'SELECT THE ENTIRE REPORT
Range("A1").Select
Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select

'SORT THE SELECTION
Selection.Sort Key1:=Range("BI2"), Order1:=xlAscending, Header:=xlYes, _
OrderCustom:=1, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal

Dim FirstAddress As String
Dim MyArr As Variant
Dim Rng As Range
Dim Rcount As Long
Dim I As Long

Application.ScreenUpdating = False

Dim Month As String, Title As String
Dim ChangeMonth As Variant
Month = ""
Title = "Update Month"
ChangeMonth = Application.InputBox(Month, Title)
Dim UserRange As Range


MyArr = Array(Month)

Rcount = 0
With Sheets("YTD").Range("BI:BI")

For I = LBound(MyArr) To UBound(MyArr)


Set Rng = .Find(What:=MyArr(I), _
After:=.Cells(.Cells.Count), _
LookIn:=xlFormulas, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
If Not Rng Is Nothing Then
FirstAddress = Rng.Address
Do
Rcount = Rcount + 1
' This example will only copy the value
Sheets.Add
ActiveSheet.Range("A" & Rcount).Value = Rng.Value
Set Rng = .FindNext(Rng)
Loop While Not Rng Is Nothing And Rng.Address <> FirstAddress
End If
Next I
End With
Application.ScreenUpdating = True

 

[Debra Dalgleish]

Instead of sorting by month, you could use an Advanced Filter to extract
the current month's data to a new worksheet. Record the steps as you
filter manually, then add that to your code. There are instructions in
Excel's help, and here:

http://www.contextures.com/xladvfilter01.html

Scenario...

Sort by month, extract current month, copy to new sheet and then pivot. So
far, I've only been able to succeed in sorting only. The INput box will come
up, and the new sheet is added, but not the rest. Could someone look this
over and tell me what I'm doing wrong? I haven't gotten to the pivoting this
yet...

Sub MakePivots()
Dim sFile
Dim xlBook As Excel.Workbook
Dim xlSheet1 As Worksheet

'OPEN CURRENT MONTH HIRE REPORT
MsgBox "Open this month's HIRE report", [vbOKOnly]
sFile = Application.GetOpenFilename("Excel Files (*.xls), *.xls")
If sFile <> False Then
End If

Set xlBook = Workbooks.Open(sFile)
Set xlSheet1 = xlBook.Worksheets("YTD")

'SELECT THE ENTIRE REPORT
Range("A1").Select
Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select

'SORT THE SELECTION
Selection.Sort Key1:=Range("BI2"), Order1:=xlAscending, Header:=xlYes, _
OrderCustom:=1, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal

Dim FirstAddress As String
Dim MyArr As Variant
Dim Rng As Range
Dim Rcount As Long
Dim I As Long

Application.ScreenUpdating = False

Dim Month As String, Title As String
Dim ChangeMonth As Variant
Month = ""
Title = "Update Month"
ChangeMonth = Application.InputBox(Month, Title)
Dim UserRange As Range


MyArr = Array(Month)

Rcount = 0
With Sheets("YTD").Range("BI:BI")

For I = LBound(MyArr) To UBound(MyArr)


Set Rng = .Find(What:=MyArr(I), _
After:=.Cells(.Cells.Count), _
LookIn:=xlFormulas, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
If Not Rng Is Nothing Then
FirstAddress = Rng.Address
Do
Rcount = Rcount + 1
' This example will only copy the value
Sheets.Add
ActiveSheet.Range("A" & Rcount).Value = Rng.Value
Set Rng = .FindNext(Rng)
Loop While Not Rng Is Nothing And Rng.Address <> FirstAddress
End If
Next I
End With
Application.ScreenUpdating = True