I have a macro I use to audit some records. It is pulling data from one sheet and generating an audit sheet before the original data sheet. Currently the results sheet is names Audit. I am collecting the name of the source sheet with an inputbox and would like to have the results sheet be named Audit with the name of the source sheet. For example, the source sheet might be named "4-6" so the result sheet should be named Audit 4-6. Since the source sheet is captured in the wshSource variable I tried using ("Audit" & wshShource) but it didn't change the name. I have included the code below. Any making this work is appreciated. Any other suggestions that would clean this code up are also appreciated.
Greg
Code: Select all
Dim wshSource As Worksheet
Dim wshTarget As Worksheet
Dim wshAudit As Worksheet
Dim i As Long
Dim n As Long
Dim j As Long
Dim RowNdx As Long
Dim ColNum As Integer
Const strFilledCol = "A"
Const strBegTmCol = "H"
Const strEndTmCol = "J"
Const strShiftHrCol = "K"
Application.ScreenUpdating = False
Set wshSource = Worksheets(InputBox("Select a worksheet name: "))
On Error Resume Next
Set wshTarget = Worksheets("working")
If wshTarget Is Nothing Then
Set wshTarget = Worksheets.Add(before:=Worksheets(Worksheets.Count))
wshTarget.Name = "working"
wshTarget.Cells.ClearContents
wshSource.Range("1:1").Copy
wshTarget.Paste Destination:=wshTarget.Range("A1")
wshSource.Activate
End If
' process for begin times = midnight
n = wshSource.Range(strFilledCol & 65536).End(xlUp).Row
j = wshTarget.Range(strFilledCol & 65536).End(xlUp).Row
For i = n To 2 Step -1
If Format(wshSource.Range(strBegTmCol & i), "hh:mm AM/PM") = "12:00 AM" Then
j = j + 1
With wshSource.Rows(i)
.Copy Destination:=wshTarget.Rows(j)
End With
End If
Next i
' process for end times = midight
n = wshSource.Range(strFilledCol & 65536).End(xlUp).Row
j = wshTarget.Range(strFilledCol & 65536).End(xlUp).Row
For i = n To 2 Step -1
If Format(wshSource.Range(strEndTmCol & i), "hh:mm AM/PM") = "11:59 PM" Then
j = j + 1
With wshSource.Rows(i)
.Copy Destination:=wshTarget.Rows(j)
End With
End If
Next i
' process for shift hours greater than 8
n = wshSource.Range(strFilledCol & 65536).End(xlUp).Row
j = wshTarget.Range(strFilledCol & 65536).End(xlUp).Row
For i = n To 2 Step -1
If wshSource.Range(strShiftHrCol & i) > 8 Then
j = j + 1
With wshSource.Rows(i)
.Copy Destination:=wshTarget.Rows(j)
End With
End If
Next i
' remove duplicates
On Error Resume Next
Set wshAudit = Worksheets("Audit")
If wshAudit Is Nothing Then
Set wshAudit = Worksheets.Add(before:=Worksheets(Worksheets.Count))
wshAudit.Name = "Audit"
wshAudit.Cells.ClearContents
wshTarget.Range("1:1").Copy
wshAudit.Paste Destination:=wshTarget.Range("A1")
wshTarget.Activate
End If
Range("A1").Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.AdvancedFilter Action:=xlFilterInPlace, Unique:=True
Selection.Copy
Sheets("Audit").Select
ActiveSheet.Paste
Sheets("working").Select
Application.CutCopyMode = False
Application.DisplayAlerts = False
ActiveWindow.SelectedSheets.Delete
Application.DisplayAlerts = True
'Prepare data for emailing
Selection.Sort Key1:=Range("A2"), Order1:=xlAscending, Key2:=Range("F2") _
, Order2:=xlAscending, Key3:=Range("G2"), Order3:=xlAscending, Header:= _
xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal, DataOption2:=xlSortNormal, DataOption3:= _
xlSortNormal
Selection.Sort Key1:=Range("D2"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Selection.AutoFilter
Cells.Select
Cells.EntireColumn.AutoFit
Range("A1").Select
' reset sytem
Set wshTarget = Nothing
Set wshSource = Nothing
Application.ScreenUpdating = True
