PDA

View Full Version : VBA: Change conditionally highlighted rows from current date to 24 hours



mikesoll
09-04-2013, 10:37 AM
I inherited an Excel 2010 workbook that is utilized to import in another excel data feed that is extracted from online source daily. Once imported this .xlsm workbook does several things, custom columns, several sorts, conditional formatting, etc. It currently highlights all rows that have a CreatedDate of the current date. I need to modify this to evaluated the CreatedDate and highlight all rows in the last 24 hours as opposed to just the current date. I am struggling to find where I need to modify this code which is listed below. Additionally, to address a sorting problem, the initial creator of this strips the time of the CreateDate field upon import. The code below refers to the specific section of the macro that performs the highlighting of rows.. There is additional code that you may want to see I wanted to try to keep it simple...
highlightFields

moveRegulatory
Worksheets("Proposals").Select
tDate = False
For count = 1 To finalrow
If Range("AU" & count).Value = Date Then tDate = True
If tDate = True And Range("AU" & count).Value <> Date Then
ActiveWindow.SelectedSheets.HPageBreaks.Add Before:=Cells(count, 1)
tDate = False
End If


Next
End If
Dim reghear As String
For x = 1 To finalcol
Select Case Trim(Cells(2, x).Text)
Case "Regulatory Hearing Date"
reghear = MyColumnLetter(x * 1)
Exit For
End Select
Next
Columns("AX:AZ").Cut
Columns("AL:AL").Insert shift:=xlToRight
Columns(reghear).Cut
Columns("E:E").Insert shift:=xlToRight
Columns("J:J").Cut
Columns("E:E").Insert shift:=xlToRight
Columns("Y:Y").Cut
Columns("G:G").Insert shift:=xlToRight

For x = 1 To finalcol
Select Case Trim(Cells(2, x).Text)
Case "Regulatory Hearing Date"
reghear = MyColumnLetter(x * 1)
Columns(reghear).Hidden = True
Exit For
End Select
Next

Range("A3").Select
ActiveWindow.FreezePanes = True
Set fldialog = Nothing
Set dict = Nothing
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub

mikesoll
09-04-2013, 10:39 AM
I wanted to include the entire VBA module in case I missed something that would be useful.

Sub find_Columns(control As IRibbonControl)
Dim finalrow, finalcol, afinalrow, afinalcol As Long
Dim fldialog As FileDialog

Dim colHeaders() As Variant
Dim dict As Scripting.Dictionary
Dim count, i, x As Long
Dim currwb, sourcewb As Workbook
Dim currwbstr, sourcewbstr As String
Dim currws, sourcews As Worksheet
Dim electionsTitle, electionsFooter As String
Dim tDate As Boolean

colHeaders = Array("MEP Landman", "Proposal Date", "Election Due Date", "Project Type", "Proposed Operator", _
"Property No", "Well Name", "CHK Division", "District", "Legal Description", "County", "State", "GEO Objective", _
"MEP Entity", "MEP Prod WI", "MEP Prod WI", "MEP Prod NRI", "Total AFE", "MEP Total", "Approved/Election Date", _
"Election", "Land Comments", "Other WI % Owners", "Regulatory Hearing Date", "JOA", "Prepay Required", "RsvCat", "Gross EUR MMCF", "Gross EUR MBO")

Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set fldialog = Application.FileDialog(msoFileDialogFilePicker)
fldialog.AllowMultiSelect = False
fldialog.Show

If fldialog.SelectedItems.count = 0 Then
Exit Sub
End If

Set dict = New Scripting.Dictionary

Set currwb = ActiveWorkbook
currwbstr = ActiveWorkbook.Name
Set currws = currwb.Worksheets("Proposals")

With currws.Columns
.Delete
End With

ActiveSheet.ResetAllPageBreaks

sourcewbstr = fldialog.SelectedItems.Item(1)
If InStr(1, LCase(sourcewbstr), "made", vbTextCompare) Then
electionsTitle = "Elections Made"
electionsFooter = "Elections_Made " & Date
Else
electionsTitle = "Elections Pending"
electionsFooter = "Elections_Pending " & Date
End If
Workbooks.Open Filename:=sourcewbstr
Set sourcewb = ActiveWorkbook
sourcewbstr = ActiveWorkbook.Name
Set sourcews = sourcewb.Worksheets("Sheet1")
Worksheets("Sheet1").Activate
finalcol = sourcews.Cells.Find("*", searchorder:=xlByColumns, searchdirection:=xlPrevious).Column
finalrow = sourcews.Cells.Find("*", searchorder:=xlByRows, searchdirection:=xlPrevious).Row
Range("A1:" & MyColumnLetter(finalcol * 1) & finalrow).Copy
Windows(currwbstr).Activate
currws.Range("A1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=True, Transpose:=False
sourcewb.Close False

finalcol = currws.Cells.Find("*", searchorder:=xlByColumns, searchdirection:=xlPrevious).Column
For count = 1 To finalcol
Select Case Trim(Cells(1, count).Text)
Case "Proposal Date", "Election Due Date", "Created Date", "Approved/Election Date", "Regulatory Hearing Date", "Proposal Received Date"
Columns(MyColumnLetter(count * 1)).NumberFormat = "m/d/yyyy"
Case "Property No"
Columns(MyColumnLetter(count * 1)).NumberFormat = "General"
Case "MEP Drill WI", "MEP Comp WI", "MEP Prod WI", "MEP Prod WI", "MEP Prod NRI"
Columns(MyColumnLetter(count * 1)).NumberFormat = "0.00000000"
Case "MEP Net Acres Cal"
Cells(1, count) = "MEP Net Acres"
Columns(MyColumnLetter(count * 1)).NumberFormat = "0.00000"
Case "Total AFE", "MEP Total"
Columns(MyColumnLetter(count * 1)).NumberFormat = "$#,##0"
Case Else
End Select
Next

Columns("X:X").Cut
Columns("AN:AN").Insert shift:=xlToRight
Columns("BA:BA").Cut
Columns("AY:AY").Insert shift:=xlToRight

finalrow = currws.Cells.Find("*", searchorder:=xlByRows, searchdirection:=xlPrevious).Row
For count = 2 To finalrow
Range("AU" & count).Value = Format(Range("AU" & count).Value, "Short Date" + "Short Time")
Next

If electionsTitle = "Elections Pending" Then
ActiveWorkbook.Worksheets("Proposals").Sort.SortFields.Clear
'created date
ActiveWorkbook.Worksheets("Proposals").Sort.SortFields.Add Key:=Range( _
"AU2:AU" & finalrow), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= _
xlSortNormal
'election due date
ActiveWorkbook.Worksheets("Proposals").Sort.SortFields.Add Key:=Range( _
"D2:D" & finalrow), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
'legal description
ActiveWorkbook.Worksheets("Proposals").Sort.SortFields.Add Key:=Range( _
"S2:S" & finalrow), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
'state
ActiveWorkbook.Worksheets("Proposals").Sort.SortFields.Add Key:=Range( _
"U2:U" & finalrow), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
'county
ActiveWorkbook.Worksheets("Proposals").Sort.SortFields.Add Key:=Range( _
"T2:T" & finalrow), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
With ActiveWorkbook.Worksheets("Proposals").Sort
.SetRange Range("A1:BB" & finalrow)
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With

Else
ActiveWorkbook.Worksheets("Proposals").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Proposals").Sort.SortFields.Add Key:=Range( _
"AN2:AN" & finalrow), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= _
xlSortNormal
ActiveWorkbook.Worksheets("Proposals").Sort.SortFields.Add Key:=Range( _
"S2:S" & finalrow), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
ActiveWorkbook.Worksheets("Proposals").Sort.SortFields.Add Key:=Range( _
"U2:U" & finalrow), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
ActiveWorkbook.Worksheets("Proposals").Sort.SortFields.Add Key:=Range( _
"T2:T" & finalrow), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
With ActiveWorkbook.Worksheets("Proposals").Sort
.SetRange Range("A1:BB" & finalrow)
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
End If

Rows(1).Insert shift:=xlDown, copyorigin:=xlFormatFromLeftOrAbove
finalcol = currws.Cells.Find("*", searchorder:=xlByColumns, searchdirection:=xlPrevious).Column
With currws.Range("A1:" & MyColumnLetter(finalcol * 1) & "2").Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 12835293
.TintAndShade = 0
.PatternTintAndShade = 0
End With

With currws.Range("A1:" & MyColumnLetter(finalcol * 1) & "2")
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
.Font.Bold = True
End With

With currws.Range("A1")
.Value = electionsTitle
.WrapText = False
.HorizontalAlignment = xlLeft
End With

formatBorders

currws.Columns.AutoFit
currws.Rows.AutoFit
finalcol = currws.Cells.Find("*", searchorder:=xlByColumns, searchdirection:=xlPrevious).Column


For i = 0 To UBound(colHeaders)
If Not dict.Exists(colHeaders(i)) Then
dict.Add colHeaders(i), colHeaders(i)
End If
Next i

For count = finalcol To 1 Step -1
If Not dict.Exists(Trim(Cells(2, count))) Then Columns(count).Hidden = True
Next
finalcol = currws.Cells.Find("*", searchorder:=xlByColumns, searchdirection:=xlPrevious).Column
currws.Range("A2:" & MyColumnLetter(finalcol * 1) & "2").AutoFilter
Columns.WrapText = True
Range("A1").WrapText = False
Rows("2:2").RowHeight = 38.25
finalcol = currws.Cells.Find("*", searchorder:=xlByColumns, searchdirection:=xlPrevious).Column
For count = 1 To finalcol
Select Case Trim(Cells(2, count).Text)
Case "MEP Landman"
Columns(count).ColumnWidth = 8.71
Case "Proposal Date"
Columns(count).ColumnWidth = 9.14
Case "Election Due Date"
Columns(count).ColumnWidth = 9.14
Case "Project Type"
Columns(count).ColumnWidth = 7.43
Case "Regulatory Hearing Date"
Columns(count).ColumnWidth = 15.29
Case "Proposed Operator"
Cells(2, count) = "Operator"
Columns(count).ColumnWidth = 15.29
Case "Property No"
Columns(count).ColumnWidth = 7.86
Case "Well Name"
Columns(count).ColumnWidth = 19.29
Case "CHK Division"
Columns(count).ColumnWidth = 14.71
Case "District"
Columns(count).ColumnWidth = 13.14
Case "Legal Description"
Columns(count).ColumnWidth = 18.71
Case "Prepay Required"
Columns(count).ColumnWidth = 11.43
Case "County"
Columns(count).ColumnWidth = 8.43
Case "State"
Cells(2, count) = "St"
Columns(count).ColumnWidth = 3.43
Case "GEO Objective"
Columns(count).ColumnWidth = 12.29
Case "MEP Entity"
Columns(count).ColumnWidth = 8
Case "MEP Prod WI"
Columns(count).ColumnWidth = 10.43
Case "MEP Prod NRI"
Columns(count).ColumnWidth = 10.57
Case "Total AFE"
Columns(count).ColumnWidth = 12.14
Case "MEP Total"
Columns(count).ColumnWidth = 10.71
' Case "MEP Net Acres"
' Columns(count).ColumnWidth = 7.71
Case "Approved/Election Date"
Columns(count).ColumnWidth = 9
Case "Election"
Columns(count).ColumnWidth = 9.71
Case "JOA"
Columns(count).ColumnWidth = 27.57
Case "Other WI % Owners"
Columns(count).ColumnWidth = 27.57
Case "RsvCat", "Gross EUR MMCF", "Gross EUR MBO"
Columns(count).ColumnWidth = 8.14
Case "Land Comments"
Columns(count).ColumnWidth = 50.29
Case Else
End Select
Next
finalrow = currws.Cells.Find("*", searchorder:=xlByRows, searchdirection:=xlPrevious).Row

With Rows("3:" & finalrow)
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlCenter
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With

Rows("3:" & finalrow).EntireRow.AutoFit

With ActiveSheet.PageSetup
.CenterHeader = "MEP Proposals"
.RightHeader = electionsFooter
.PrintTitleRows = "$1:$2"
End With
Dim notToday As Long
For count = 3 To finalrow
If Range("AU" & count).Value <> Date Then
notToday = count
Exit For
End If
Next
If electionsTitle = "Elections Pending" Then
Range("A" & notToday & ":BB" & finalrow).Select
ActiveWorkbook.Worksheets("Proposals").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Proposals").Sort.SortFields.Add Key:=Range( _
"D" & notToday & ":D" & finalrow), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
ActiveWorkbook.Worksheets("Proposals").Sort.SortFields.Add Key:=Range( _
"S" & notToday & ":S" & finalrow), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
ActiveWorkbook.Worksheets("Proposals").Sort.SortFields.Add Key:=Range( _
"U" & notToday & ":U" & finalrow), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
ActiveWorkbook.Worksheets("Proposals").Sort.SortFields.Add Key:=Range( _
"T" & notToday & ":T" & finalrow), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
With ActiveWorkbook.Worksheets("Proposals").Sort
.SetRange Range("A" & notToday & ":BB" & finalrow)
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
highlightFields

moveRegulatory
Worksheets("Proposals").Select
tDate = False
For count = 1 To finalrow
If Range("AU" & count).Value = Date Then tDate = True
If tDate = True And Range("AU" & count).Value <> Date Then
ActiveWindow.SelectedSheets.HPageBreaks.Add Before:=Cells(count, 1)
tDate = False
End If


Next
End If
Dim reghear As String
For x = 1 To finalcol
Select Case Trim(Cells(2, x).Text)
Case "Regulatory Hearing Date"
reghear = MyColumnLetter(x * 1)
Exit For
End Select
Next
Columns("AX:AZ").Cut
Columns("AL:AL").Insert shift:=xlToRight
Columns(reghear).Cut
Columns("E:E").Insert shift:=xlToRight
Columns("J:J").Cut
Columns("E:E").Insert shift:=xlToRight
Columns("Y:Y").Cut
Columns("G:G").Insert shift:=xlToRight

For x = 1 To finalcol
Select Case Trim(Cells(2, x).Text)
Case "Regulatory Hearing Date"
reghear = MyColumnLetter(x * 1)
Columns(reghear).Hidden = True
Exit For
End Select
Next

Range("A3").Select
ActiveWindow.FreezePanes = True
Set fldialog = Nothing
Set dict = Nothing
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
Public Sub CreateTab(tname As String)
Dim wb As Workbook
Dim ws As Worksheet
Dim trg As Worksheet
checkforTab (tname)
Set wb = ActiveWorkbook
Set trg = wb.Worksheets.Add(After:=wb.Worksheets(wb.Worksheets.count))
trg.Name = tname
Set ws = wb.Worksheets(wb.Worksheets.count)
Set wb = Nothing
Set trg = Nothing
Set ws = Nothing
End Sub
Public Sub checkforTab(tname As String)
Dim wb As Workbook
Dim ws As Worksheet
Set wb = ActiveWorkbook
For Each ws In wb.Worksheets
If LCase(ws.Name) = LCase(tname) Then
Sheets(ws.Name).Delete
End If
Next ws
End Sub
Function MyColumnLetter(MyColumn As Long)
If MyColumn > 26 Then
MyColumnLetter = Chr(Int((MyColumn - 1) / 26) + 64) & Chr(((MyColumn - 1) Mod 26) + 65)
Else
MyColumnLetter = Chr(MyColumn + 64)
End If
End Function
Public Sub formatBorders()
Dim finalcol As Long
finalcol = Cells.Find("*", searchorder:=xlByColumns, searchdirection:=xlPrevious).Column
Range("A2:" & MyColumnLetter(finalcol * 1) & "2").Borders(xlDiagonalDown).LineStyle = xlNone
Range("A2:" & MyColumnLetter(finalcol * 1) & "2").Borders(xlDiagonalUp).LineStyle = xlNone
With Range("A2:" & MyColumnLetter(finalcol * 1) & "2").Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Range("A2:" & MyColumnLetter(finalcol * 1) & "2").Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Range("A2:" & MyColumnLetter(finalcol * 1) & "2").Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Range("A2:" & MyColumnLetter(finalcol * 1) & "2").Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Range("A2:" & MyColumnLetter(finalcol * 1) & "2").Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Range("A2:" & MyColumnLetter(finalcol * 1) & "2").Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
End Sub
Public Sub highlightFields()
Dim finalrow, finalcol, x As Long
Dim cd, election, elec_dd, proj_type As String
finalcol = Cells.Find("*", searchorder:=xlByColumns, searchdirection:=xlPrevious).Column
finalrow = Cells.Find("*", searchorder:=xlByRows, searchdirection:=xlPrevious).Row
For x = 1 To finalcol
Select Case Trim(Cells(2, x).Text)
Case "Election Due Date"
elec_dd = MyColumnLetter(x * 1)
Case "Created Date"
cd = MyColumnLetter(x * 1)
Case "Election"
election = MyColumnLetter(x * 1)
Case "Project Type"
proj_type = MyColumnLetter(x * 1)
End Select
Next
For x = 3 To finalrow


If DateDiff("d", Date, Range(elec_dd & x).Value) <= 7 Then
With Range(elec_dd & x).Font
.Bold = True
.Color = -16776961
.TintAndShade = 0
End With
End If
If CStr(Range(cd & x).Value) = CStr(Date) Then
If Trim(Range(election & x).Value) <> "" Then
With Range(election & x).Font
.Bold = True
.Color = -16776961
.TintAndShade = 0
End With
End If

With Range("A" & x & ":" & MyColumnLetter(finalcol * 1) & x).Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent3
.TintAndShade = 0.799981688894314
.PatternTintAndShade = 0
End With

End If
If Range(proj_type & x) = "Initial Well" Then
With Range(elec_dd & x).Font
.ColorIndex = xlAutomatic
.TintAndShade = 0
End With
End If
Next
End Sub

Public Sub moveRegulatory()
Dim finalrow, finalcol, x, permrow, pasterow, i, count As Long
Dim pt As String
Dim foundReg As Boolean
foundReg = False
Dim newtab As String
Dim c As Range
Dim wb As Workbook
Dim aws, cws As Worksheet

Dim colHeaders() As Variant
Dim dict As Scripting.Dictionary

colHeaders = Array("MEP Landman", "Proposal Date", "Election Due Date", "Project Type", "Operator", _
"Property No", "Well Name", "CHK Division", "District", "Legal Description", "County", "St", "GEO Objective", _
"MEP Entity", "MEP Prod WI", "MEP Prod WI", "MEP Prod NRI", "Total AFE", "MEP Total", "Approved/Election Date", _
"Election", "Land Comments", "Other WI % Owners", "Regulatory Hearing Date", "JOA", "MEP Net Acres", "Prepay Required", "RsvCat", "Gross EUR MMCF", "Gross EUR MBO")


Set wb = ActiveWorkbook
Set cws = Worksheets("Proposals")
Set dict = New Scripting.Dictionary

finalcol = Cells.Find("*", searchorder:=xlByColumns, searchdirection:=xlPrevious).Column
finalrow = Cells.Find("*", searchorder:=xlByRows, searchdirection:=xlPrevious).Row
permrow = finalrow + 2
pasterow = finalrow + 2

For x = 1 To finalcol
Select Case Trim(Cells(2, x).Text)
Case "Project Type"
pt = MyColumnLetter(x * 1)
Exit For
End Select
Next
For x = finalrow To 3 Step -1
If LCase(Left(Range(pt & x), 10)) = "regulatory" Then
foundReg = True
Rows(x).Cut
Rows(pasterow).Insert
permrow = permrow - 1
pasterow = Cells.Find("*", searchorder:=xlByRows, searchdirection:=xlPrevious).Row + 1
End If
Next
If foundReg = False Then Exit Sub
finalrow = Cells.Find("*", searchorder:=xlByRows, searchdirection:=xlPrevious).Row
Range("A" & permrow & ":BB" & finalrow).Select
ActiveWorkbook.Worksheets("Proposals").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Proposals").Sort.SortFields.Add Key:=Range( _
"AH" & permrow & ":AH" & finalrow), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= _
xlSortNormal
ActiveWorkbook.Worksheets("Proposals").Sort.SortFields.Add Key:=Range( _
"S" & permrow & ":S" & finalrow), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
ActiveWorkbook.Worksheets("Proposals").Sort.SortFields.Add Key:=Range( _
"U" & permrow & ":U" & finalrow), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
ActiveWorkbook.Worksheets("Proposals").Sort.SortFields.Add Key:=Range( _
"T" & permrow & ":T" & finalrow), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
With ActiveWorkbook.Worksheets("Proposals").Sort
.SetRange Range("A" & permrow & ":BB" & finalrow)
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
cws.Range("A" & permrow & ":BB" & finalrow).Copy
wb.Worksheets.Add After:=wb.Worksheets(wb.Worksheets.count)
newtab = "Regulatory"
Sheets(wb.Worksheets.count).Name = newtab
Set aws = Worksheets(newtab)
aws.Range("A2").PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:=xlNone, SkipBlanks:=True, Transpose:=False
cws.Rows(permrow & ":" & finalrow).Delete
cws.Range("A2:BB2").Copy
aws.Range("A1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=True, Transpose:=False
Worksheets("Regulatory").Select
aws.Rows(1).Insert shift:=xlDown, copyorigin:=xlFormatFromLeftOrAbove
finalcol = aws.Cells.Find("*", searchorder:=xlByColumns, searchdirection:=xlPrevious).Column
With aws.Range("A1:" & MyColumnLetter(finalcol * 1) & "2").Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 12835293
.TintAndShade = 0
.PatternTintAndShade = 0
End With

With aws.Range("A1:" & MyColumnLetter(finalcol * 1) & "2")
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
.Font.Bold = True
End With

With aws.Range("A1")
.Value = "Regulatory"
.WrapText = False
.HorizontalAlignment = xlLeft
End With

formatBorders

aws.Columns.AutoFit
aws.Rows.AutoFit

finalcol = aws.Cells.Find("*", searchorder:=xlByColumns, searchdirection:=xlPrevious).Column
aws.Range("A2:" & MyColumnLetter(finalcol * 1) & "2").AutoFilter
aws.Columns.WrapText = True
aws.Range("A1").WrapText = False
aws.Rows("2:2").RowHeight = 38.25
finalrow = aws.Cells.Find("*", searchorder:=xlByRows, searchdirection:=xlPrevious).Row

With Rows("3:" & finalrow)
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlCenter
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With

For i = 0 To UBound(colHeaders)
If Not dict.Exists(colHeaders(i)) Then
dict.Add colHeaders(i), colHeaders(i)
End If
Next i

For count = finalcol To 1 Step -1
If Not dict.Exists(Trim(Cells(2, count))) Then Columns(count).Hidden = True
Next
finalcol = aws.Cells.Find("*", searchorder:=xlByColumns, searchdirection:=xlPrevious).Column
For count = 1 To finalcol
Select Case Trim(Cells(2, count).Text)
Case "MEP Landman"
Columns(count).ColumnWidth = 8.71
Case "Proposal Date"
Columns(count).ColumnWidth = 9.14
Case "Election Due Date"
Columns(count).ColumnWidth = 9.14
Case "Project Type"
Columns(count).ColumnWidth = 7.43
Case "Regulatory Hearing Date"
Columns(count).ColumnWidth = 15.29
Case "Operator"
Columns(count).ColumnWidth = 15.29
Case "Property No"
Columns(count).ColumnWidth = 7.86
Case "Well Name"
Columns(count).ColumnWidth = 19.29
Case "CHK Division"
Columns(count).ColumnWidth = 14.71
Case "District"
Columns(count).ColumnWidth = 13.14
Case "Legal Description"
Columns(count).ColumnWidth = 18.71
Case "Prepay Required"
Columns(count).ColumnWidth = 11.43
Case "County"
Columns(count).ColumnWidth = 8.43
Case "St"
Columns(count).ColumnWidth = 3.43
Case "GEO Objective"
Columns(count).ColumnWidth = 12.29
Case "MEP Entity"
Columns(count).ColumnWidth = 8
Case "MEP Prod WI"
Columns(count).ColumnWidth = 10.43
Case "MEP Prod NRI"
Columns(count).ColumnWidth = 10.57
Case "Total AFE"
Columns(count).ColumnWidth = 12.14
Case "MEP Total"
Columns(count).ColumnWidth = 10.71
Case "MEP Net Acres"
Columns(count).ColumnWidth = 7.71
Case "Approved/Election Date"
Columns(count).ColumnWidth = 9
Case "Election"
Columns(count).ColumnWidth = 9.71
Case "JOA"
Columns(count).ColumnWidth = 27.57
Case "Other WI % Owners"
Columns(count).ColumnWidth = 27.57
Case "RsvCat", "Gross EUR MMCF", "Gross EUR MBO"
Columns(count).ColumnWidth = 8.14
Case "Land Comments"
Columns(count).ColumnWidth = 50.29
Case Else
End Select
Next

Dim reghear As String
For x = 1 To finalcol
Select Case Trim(Cells(2, x).Text)
Case "Regulatory Hearing Date"
reghear = MyColumnLetter(x * 1)
Exit For
End Select
Next
Columns("AX:AZ").Cut
Columns("AN:AN").Insert shift:=xlToRight
Columns(reghear).Cut
Columns("E:E").Insert shift:=xlToRight
Columns("J:J").Cut
Columns("F:F").Insert shift:=xlToRight
Columns("Y:Y").Cut
Columns("G:G").Insert shift:=xlToRight
Range("A3").Select
ActiveWindow.FreezePanes = True
format_Regulatory
Set dict = Nothing
End Sub
Sub format_Regulatory()
With ActiveSheet.PageSetup
.PrintTitleRows = "$1:$2"
.LeftHeader = ""
.CenterHeader = "MEP Proposals - Regulatory"
.RightHeader = "Elections_Pending " & Date
.LeftFooter = ""
.CenterFooter = ""
.RightFooter = "&P of &N"
.LeftMargin = Application.InchesToPoints(0.5)
.RightMargin = Application.InchesToPoints(0.5)
.TopMargin = Application.InchesToPoints(0.5)
.BottomMargin = Application.InchesToPoints(0.5)
.HeaderMargin = Application.InchesToPoints(0.3)
.FooterMargin = Application.InchesToPoints(0.3)
.PrintHeadings = False
.PrintGridlines = True
.PrintComments = xlPrintNoComments
.PrintQuality = 600
.CenterHorizontally = False
.CenterVertically = False
.Orientation = xlLandscape
.Draft = False
.PaperSize = xlPaperLegal
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = False
.PrintErrors = xlPrintErrorsDisplayed
.OddAndEvenPagesHeaderFooter = False
.DifferentFirstPageHeaderFooter = False
.ScaleWithDocHeaderFooter = True
.AlignMarginsHeaderFooter = True
.EvenPage.LeftHeader.Text = ""
.EvenPage.CenterHeader.Text = ""
.EvenPage.RightHeader.Text = ""
.EvenPage.LeftFooter.Text = ""
.EvenPage.CenterFooter.Text = ""
.EvenPage.RightFooter.Text = ""
.FirstPage.LeftHeader.Text = ""
.FirstPage.CenterHeader.Text = ""
.FirstPage.RightHeader.Text = ""
.FirstPage.LeftFooter.Text = ""
.FirstPage.CenterFooter.Text = ""
.FirstPage.RightFooter.Text = ""
End With
End Sub