Public Sub subRestructurePayRatesGrid()
Dim rngData As Range
Dim rngColumn As Range
Dim rngRow As Range
Dim s As String
Dim WsInfo As Worksheet
Dim WsPayRates As Worksheet
Dim intRows As Integer
Dim Q As String
Dim strFormula As String
Dim arrHeaders() As String
ActiveWorkbook.Save
Set WsInfo = Worksheets("Info")
If WsInfo.Range("A1").Value = "Agency Rates Paid" Then
WsInfo.Rows(1).Delete
End If
Set rngData = WsInfo.Range("A1").CurrentRegion
On Error Resume Next
Application.DisplayAlerts = False
Worksheets("AgencyRatesPaid").Delete
Application.DisplayAlerts = True
On Error GoTo 0
Worksheets.Add after:=Sheets(Sheets.Count)
ActiveSheet.Name = "AgencyRatesPaid"
Set WsPayRates = Worksheets("AgencyRatesPaid")
WsPayRates.Activate
arrHeaders = Split("Agency Name,Employee Grade,Day,Weekday From,Weekday To,Night or Day,Rate,", ",")
WsPayRates.Range("A1").Resize(1, UBound(arrHeaders)).Value = arrHeaders
For Each rngRow In rngData.Rows
If rngRow.Row <> 1 Then
With WsPayRates.Range("G" & Rows.Count).End(xlUp).Offset(1)
.Offset(0, -4).Resize(8, 1).Value = WorksheetFunction.Transpose(WsInfo.Range("C1:J1").Value)
rngRow.Offset(0, 2).Copy
.Resize(rngRow.Columns.Count, 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
.Offset(0, -6).Resize(8, 2).Value = rngRow.Cells(1).Resize(1, 2).Value
Application.CutCopyMode = False
intRows = intRows + rngRow.Columns.Count
End With
End If
Next rngRow
With WsPayRates.Range("A1").CurrentRegion
With .Rows(1)
.Interior.Color = RGB(213, 213, 213)
.Font.Bold = True
End With
.Font.Size = 14
.Font.Name = "Arial"
.RowHeight = 30
.VerticalAlignment = xlCenter
.IndentLevel = 1
.EntireColumn.AutoFit
End With
With WsPayRates.Range("A1").CurrentRegion.Borders
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = vbBlack
End With
Q = Chr(34)
strFormula = "=IF(LEFT($C2,7)=" & Q & "Mon-Fri" & Q & ",2,IF(LEFT($C2,3)=" & Q & "Sat" & Q & ",6,IF(LEFT($C2,3)=" & Q & "Sun" & Q & _
",1,IF(LEFT($C2,4)=" & Q & "Bank" & Q & "," & Q & "Bank" & Q & "," & Q & Q & "))))"
With Range("D2").Resize(intRows, 1)
.Formula2 = strFormula
.Value = .Value
End With
strFormula = "=IF(MID($C2,5,3)=" & Q & "Fri" & Q & ",6,IF(LEFT($C2,4)=" & Q & "Bank" & Q & "," & Q & "Bank" & Q & ",D2))"
With Range("E2").Resize(intRows, 1)
.Formula2 = strFormula
.Value = .Value
End With
strFormula = "=IF(ISNUMBER(FIND(" & Q & "Night" & Q & ",$C2))," & Q & "Night" & Q & "," & Q & "Day" & Q & ")"
With Range("F2").Resize(intRows, 1)
.Formula2 = strFormula
.Value = .Value
End With
Range("A2").Select
ActiveWindow.FreezePanes = True
If WsInfo.Range("A1").Value <> "Agency Rates Paid" Then
WsInfo.Rows(1).EntireRow.Insert
WsInfo.Range("A1").Value = "Agency Rates Paid"
End If
ActiveWorkbook.Save
MsgBox "'AgencyRatesPaid' worksheet created.", vbInformation, "Confirmation."
End Sub