Hi everyone,
I have this macro that suddenly stopped working. I cant figure out why, I can post the code but not a workbook since its got protected info... but It runs until it opens the new workbook, and then it stops. Doesnt ask me for company name etc anymore, this was working this morning... very frustrating.
Anyways if anyone can help me out i'd appreciate it as this makes my day a lot easier when automated.
Sub UniqueUtilizerFinder()
'
' Macro2 Macro
'
Application.DisplayAlerts = True
ActiveSheet.Name = "SolutionDetailReport"
Application.ScreenUpdating = True
'First time or unique for month?
YesOrNo = MsgBox("First Time Unique?(if No - will return Unique Util for month)", vbYesNo)
If YesOrNo <> vbYes Then
'delete rows to sort data
Columns("A:B").Select
Selection.Delete Shift:=xlToLeft
Columns("B:L").Select
Selection.Delete Shift:=xlToLeft
Columns("C:K").Select
Selection.Delete Shift:=xlToLeft
'sort
Columns("A:B" & lastrow).Select
UtilMonth = InputBox("Filter Date From:")
UtilMonthEnd = InputBox("Filter Date To:")
'ActiveSheet.Range("$A$1:$B$" & LastRow).AutoFilter Field:=2, Criteria1:= _
">=" & UtilMonth, Operator:=xlAnd, Criteria2:="<=" & UtilMonthend
Selection.AutoFilter
ActiveSheet.Range("A:B" & lastrow).AutoFilter Field:=2, Criteria1:= _
">=" & UtilMonth, Operator:=xlAnd, Criteria2:="<=" & UtilMonthEnd
ActiveSheet.Range("A:B" & lastrow).RemoveDuplicates Columns:=1, Header:=xlYes
End If
If YesOrNo = vbYes Then
'delete rows to sort data
Columns("A:B").Select
Selection.Delete Shift:=xlToLeft
Columns("B:L").Select
Selection.Delete Shift:=xlToLeft
Columns("C:K").Select
Selection.Delete Shift:=xlToLeft
'sort
lastrow = ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Row
Columns("A:B").Select
ActiveWorkbook.Worksheets("SolutionDetailReport").Sort.SortFields.Add Key:= _
Range("A2:A" & lastrow), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption _
:=xlSortNormal
ActiveWorkbook.Worksheets("SolutionDetailReport").Sort.SortFields.Add Key:= _
Range("B2:B" & lastrow), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption _
:=xlSortNormal
With ActiveWorkbook.Worksheets("SolutionDetailReport").Sort
.SetRange Range("A1:B" & lastrow)
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
'insert formula into column C
Range("C1").Select
ActiveCell.FormulaR1C1 = "Countif"
Range("C2").Select
ActiveCell.FormulaR1C1 = "=COUNTIF(R1C[-2]:RC[-2], RC[-2])"
Range("C2").Select
Selection.AutoFill Destination:=Range("C2:C" & lastrow), Type:=xlFillDefault
Range("C2:C" & lastrow).Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'filter data to what you need
UtilMonth = InputBox("Filter Date From:")
UtilMonthEnd = InputBox("Filter Date To:")
TimesCounted = InputBox("Enter the number of times a caller can be counted per month")
Range("A1:C1").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.AutoFilter
ActiveSheet.Range("$A$1:$C$" & lastrow).AutoFilter Field:=2, Criteria1:= _
">=" & UtilMonth, Operator:=xlAnd, Criteria2:="<=" & UtilMonthEnd
ActiveSheet.Range("$A$1:$C" & lastrow).AutoFilter Field:=3, Criteria1:=TimesCounted
End If
'open utilization template
Workbooks.Open filename:="Z:\Reporting\1Reports Main\Report Templates\Incentive Utilization List Template.xlsx"
DoEvents
CompanyName = InputBox("Company Name")
Range("a10").Value = CompanyName
Range("A11").Value = UtilMonth & " to " & UtilMonthEnd
Range("A12").Value = InputBox("Enter Incentive Description")
Range("A1").Select
''''''''''''''''''''''''
Dim lngCounter As Long
Dim lngCol As Long
Dim rngCell As Range
Const clngSTART As Long = 15
Const clngLENGTH As Long = 28
With Workbooks("SolutionDetailReport").Sheets("SolutionDetailReport")
lngCol = 1
For Each rngCell In .Range("A2:A" & .Cells(Rows.Count, "A").End(xlUp).Row).SpecialCells(xlCellTypeVisible)
Workbooks("Incentive Utilization List Template").Sheets("sheet1").Cells(clngSTART + lngCounter, lngCol).Value = rngCell.Value
lngCounter = lngCounter + 1
If lngCounter = clngLENGTH Then
lngCounter = 0
lngCol = lngCol + 2
End If
DoEvents
Next rngCell
End With
''''''''''''''''''''''
'open save as dialogue box
Dim DTAddress As String, myFileName As String
Dim sFile As String
Sheets("Sheet1").Select
myFileName = Range("A10").Value & " - " & Range("A5").Value & " - " & Format(Date, "mm - dd - yyyy")
sFile = Application.GetSaveAsFilename(InitialFileName:=myFileName, fileFilter:="Excel Files (*.xls*), *.xls*")
''''''''''''''''''''''' havent debugged below here. feel free to fix! im trying to get it to save a pdf copy wherever i choose to save the file.
'save as pdf
Dim filepathforpdf As String
filepathforpdf = Application.ActiveWorkbook.FullName
ActiveSheet.ExportAsFixedFormat _
Type:=xlTypePDF, _
filename:=myFileName, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=False
End Sub
Bookmarks