• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

Macro via Recorder

Zach

Member
Good evening,
I am trying to clean up a macro that I recorded with the recorder. Its basic function of the macro is to filter all the data labeled to Phoenix (Column B), paste it on a new tab and then sort and subtotal by column G. I've gotten the majority of that accomplished, but I tried adding some extra tasks in the macro and I'm not sure how to clean it up.
1. I'd like to carry over only Columns A through K, not L.
2. I want the file to automatically create borders based on where the data is and not the range I set it at. I'm just unaware of how to write that.
3. I don't think it's possible but if it is I'd love to learn how to format the subtotal cells a certain shade. And basically highlight any number that is greater than 500 or less than (500), but not include the shaded subtotal cells.

I'm attaching my file I have so far (11-2 to 11-8) and I will attach a finished product that I manually adjust on a weekly basis(10-26 to 11-1). Any help would be greatly appreciated.
 

Attachments

  • Copy of VPO Reasons Report Details 11-2 to 11-8.xlsm
    166.4 KB · Views: 2
  • VPO Reasons Report Details 10-26 to 11-1.xlsx
    120.6 KB · Views: 1
You can try like below.

I have omitted number formatting part but the rest of the code should work as you need.
Code:
Sub VPO_Report()
'
' VPO_Report Macro
' Run VPO Report
'
'
Dim MTab As Worksheet
Dim CVT As Worksheet
Dim lLast As Long
Set CVT = Worksheets("All VPO Details")

lLast = CVT.Range("A" & Rows.Count).End(xlUp).Row

On Error Resume Next
  Application.DisplayAlerts = False
  Sheets("Phoenix").Delete
  Application.DisplayAlerts = True
On Error GoTo 0

 'create new worksheet and name
Set MTab = Sheets.Add(after:=CVT)
  MTab.Name = "Phoenix"

'Filter file
  CVT.Select
  CVT.Range(Cells(1, 1), "K" & lLast).AutoFilter Field:=2, Criteria1:="Phoenix"
  CVT.Range(Cells(1, 1), "K" & lLast).SpecialCells(xlCellTypeVisible).Copy
  MTab.Range("A1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
  :=False, Transpose:=False
  Application.CutCopyMode = False
  With MTab
  .Select
  .Cells.Select
  .Cells.EntireColumn.AutoFit
  lLast = .Range("A" & Rows.Count).End(xlUp).Row
  .Range(.Cells(1, 1), "K" & lLast).Subtotal GroupBy:=7, Function:=xlSum, TotalList:=Array(11), _
  Replace:=True, PageBreaks:=False, SummaryBelowData:=True
  lLast = .Range("G" & Rows.Count).End(xlUp).Row
  With .Range(.Cells(1, 1), "K" & lLast).Borders
  .LineStyle = xlContinuous
  .ColorIndex = 0
  .TintAndShade = 0
  .Weight = xlThin
  End With
  For i = 2 To lLast
  If .Range("G" & i).Value Like "* Total" Then
  With .Range("G" & i).Resize(1, 5).Interior
  .ColorIndex = 15  '\\verify this
  .TintAndShade = 0.149998474074526 '\\verify this
  End With
  End If
  Next i
  End With
End Sub
 
This is great I've adjusted the macro to run based off your suggestions. I've built in a conditional formatting piece to format my cost column. Does anyone know how to have conditional formatting exclude cells in a column, like the column header and any of the gray shaded cells?
 

Attachments

  • Copy of VPO Reasons Report Details 11-2 to 11-8.xlsm
    168.8 KB · Views: 0
Ok I'm 99% there, I need to reconfigure this portion of the macro to basically state that if the cells in Column K are RGB (192, 192, 192) to not conditionally format. I only need the white cells with values to be part of the formating.

Code:
'Format cost column
 Range(Range("K2"), Range("K2").End(xlDown)).Select
    Selection.NumberFormat = "#,##0.00_);[Red](#,##0.00)"
    Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlGreaterEqual _
        , Formula1:="=500"
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
    With Selection.FormatConditions(1).Interior
        .PatternColorIndex = xlAutomatic
        .Color = 65535
        .TintAndShade = 0
    End With
    Selection.FormatConditions(1).StopIfTrue = False
    Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlLessEqual, _
        Formula1:="=-500"
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
    With Selection.FormatConditions(1).Interior
        .PatternColorIndex = xlAutomatic
        .Color = 65535
        .TintAndShade = 0
        Selection.FormatConditions(1).StopIfTrue = False
    End With
 
Back
Top