Free Microsoft Excel 2013 Quick Reference

Counting Macro

I wish to create a macro "button" to be used as a tally counter.

I.e. Each press of the macro button results in a cells value to be increased by 1.

Can someone please help me with how to do this?

Thankyou!

Chris


Post your answer or comment

comments powered by Disqus
Word has a built-in word-count macro. Does excel?

A friend needs to find the total of all the words in an excel document.

Thanks,

Jack Crane

I have a spreadsheet that gets created from a report. I’m in need of a macro to help me clean the report up.
The sheet will be sorted by column “A” then by “B”. I need a macro that will insert an entire line at each change in value in “A” and insert “S-(then the # that represents that section). Then, count how many groups of 3 are in “B” and put that number below. I supplied an example. If possible I need the macro to be able to Highlight in Red groups in “B” that don’t equal 3, only 1 or 2.

Thank you very much for your time and help.
This will be a time saver.

I'm a horse-racing junkie but an Excel novice that usually survives on filtering & simple macros to pick my um.... occasional winners.

Anyway horses have 5 running styles; early speed to late closers; denoted as 1 to 5 in column Z. I'd like to count those noted as 1 thru 3 for each race.

In column FC (the last column with data) I have a race ID # for each race on the spreadsheet, somewhere between 2500 to 5000 races in each one. They're a monthly record. The race ID # is a concatenation of columns B (Track ID), C (Date) & D (race #). Each is unique to its race. E.G. Aqueduct, jan 1st, 2004, 2nd race is id'd as AQU379872.

Would it be possible to create a macro that would (A) count the number of horse 1s, horse 2s & horse 3s from a specific race ID & then post those numbers in columns FD thru FF & (B) then continue to the next race ID in column FC & count those horses from that race & so on thru the entire spreadsheet?

Would it be simpler if each race ID were changed to a number--race 1 down to race 2500?

Thanks for any help you can give me,

MtKB

Is there a way to count everytime you use a macro? The macro is tied to a button so basically I wanna count everytime that button is pushed... Is it possible?

Hi All,

Help me,. i want a macro that counts a column that is not empty,.i want it to put in a button.

and also i want to count the data that has empty match

sample

Column1 Column2
1 test1
2 test2
3 test3
4
5
6
7

macro 1 , counts the data with match,. sample result is 3

macro 2 , counts the data with empty match ,. in this sample the result is 4,.

hope somebody could...

thanks

I hate to rush all of you, but details for the macro I was creating just changed today. I now have to edit this macro tonight for a big project tomorrow, and I don't know what to do. I'm soooo sorry. I know it's a lot to ask, but any help you can give would be greatly appreciated.

In Sheet "B" I have a macro running that copies the contents of columns C&D into Sheet "Main" and columns A&B are copied from "Main" to col A&B in "B."

I need to edit the macro to do the following:
I need Col D in Sheet "B," to be the character count for Col C. If the number in col D is greater than the number in Col B then the text in col C should be red and that text should not be transferred to "Main" until Col D is less than or equal to the number in Col B.

Here is the code that is specific to Sheet "B"

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Application.EnableEvents = False
    Select Case Sh.Name
    Case "Main"
        If Target.Column = 1 Or Target.Column = 2 Then
            Sheets(Sh.Name).Columns("A:B").Copy Sheets("B").Columns("A:B")
            Sheets(Sh.Name).Columns("C:D").Copy Sheets("B").Columns("C:D")
            Sheets(Sh.Name).Columns("A:B").Copy Sheets("C").Columns("A:B")
            Sheets(Sh.Name).Columns("E:F").Copy Sheets("C").Columns("C:D")
            Sheets(Sh.Name).Columns("A:B").Copy Sheets("D").Columns("A:B")
            Sheets(Sh.Name).Columns("G:H").Copy Sheets("D").Columns("C:D")
            Sheets(Sh.Name).Columns("A:B").Copy Sheets("E").Columns("A:B")
            Sheets(Sh.Name).Columns("I:J").Copy Sheets("E").Columns("C:D")
            Sheets(Sh.Name).Columns("A:B").Copy Sheets("F").Columns("A:B")
            Sheets(Sh.Name).Columns("K:L").Copy Sheets("F").Columns("C:D")
            Sheets(Sh.Name).Columns("A:B").Copy Sheets("G").Columns("A:B")
            Sheets(Sh.Name).Columns("M:N").Copy Sheets("G").Columns("C:D")
        End If
    Case "B"
        If Target.Column = 3 Or Target.Column = 4 Then Sheets(Sh.Name).Columns("C:D").Copy
Sheets("Main").Columns("C:D")
    Case "C"
        If Target.Column = 3 Or Target.Column = 4 Then Sheets(Sh.Name).Columns("C:D").Copy
Sheets("Main").Columns("E:F")
    Case "D"
        If Target.Column = 3 Or Target.Column = 4 Then Sheets(Sh.Name).Columns("C:D").Copy
Sheets("Main").Columns("G:H")
    Case "E"
        If Target.Column = 3 Or Target.Column = 4 Then Sheets(Sh.Name).Columns("C:D").Copy
Sheets("Main").Columns("I:J")
    Case "F"
        If Target.Column = 3 Or Target.Column = 4 Then Sheets(Sh.Name).Columns("C:D").Copy
Sheets("Main").Columns("K:L")
    Case "G"
        If Target.Column = 3 Or Target.Column = 4 Then Sheets(Sh.Name).Columns("C:D").Copy
Sheets("Main").Columns("M:N")
    End Select
Application.EnableEvents = True
End Sub

I have attached the grid I'm using. It contains the 2 macros where the first one is specific to Sheet1 (Main) while the other is found in ThisWorkbook.

The macro on "Main" formats the cells in that sheet depending on the data that is inputted. The macro in ThisWorkbook runs on all the pages and it basically copies columns C:D from the Sheets B-G onto "Main."

HI,

I have data in 3 columns: Name, Inclusion Date, Exclusion Date. In some instances, the inclusion date and exclusion date will be zeroed out - I do not wish to count those. What I would like to count is the rows that have an inclusion date, but not an exclusion date. Ideally, I would like to have a code so that when I run a macro a msgbox appears that indicates how many members there are.

Thanks

Hello all.

Please allow me to explain my situation. At my company I work with a lot of text-filled Excel files. In order to get a proper word count we're currently using the primitive method of "paste into Word and run a word count". I'd like to be able to do this from within Excel, and I found the macro below but have run into a snag.
The problem I have is that it ignores carriage returns and count the last word in the first line and the first word in the following line as one word. In the files I work with this can throw off the count by thousands of words.

So if I run this macro against a cell containing a single text string:
<My name is Amejin and
I like pizza and beer> - 10 words

The macro reads it as:
<My name is Amejin andI like pizza and beer> - 9 words

So, essentially I need a method of changing carriage returns into spaces so that the macro will return the proper count. If anyone has a solution, it would be greatly appreciated.

Sub NumberOfWords()

Dim NumberOfWord As Long
Dim RangeArea As Range
Dim Str As String
Dim Num As Long

For Each RangeArea In ActiveSheet.UsedRange.Cells
Str = Application.WorksheetFunction.Trim(RangeArea.Text)
Num = 0
If Str <> "" Then
Num = Len(Str) - Len(Replace(Str, " ", "")) + 1
End If

NumberOfWord = NumberOfWord + Num

Next RangeArea

MsgBox NumberOfWord

End Sub
Thanks for your help!

I know there are compatibility issues between Excel 2003 and 2007. So, I'm pretty sure I already know my answer, but I need to ask so I can rest easy.

A co-worker built a macro in 2007. However, a majority of my company does not have 2007, only 2003. These people need this macro loaded on their PC, but the macro doesn't work on 2003.

Is there an easy "fix", or does the code need to be re-written in 2003?

Here's the code: (suggestions on making this run faster and more efficient are welcome)


	VB:
	
 EMS_Match_Report1() 
     '
     ' Macro1 Macro
     '
     
     '
    Application.ScreenUpdating = False 
    Cells.Select 
    Cells.EntireColumn.AutoFit 
    Columns("D:D").Select 
    Selection.Delete Shift:=xlToLeft 
    Columns("E:H").Select 
    Selection.Delete Shift:=xlToLeft 
    Columns("H:M").Select 
    Selection.Delete Shift:=xlToLeft 
    Columns("I:J").Select 
    Selection.Delete Shift:=xlToLeft 
    Columns("K:M").Select 
    Selection.Delete Shift:=xlToLeft 
    ActiveWindow.SmallScroll ToRight:=3 
    Columns("M:M").Select 
    Selection.Delete Shift:=xlToLeft 
    Columns("N:N").Select 
    Selection.Delete Shift:=xlToLeft 
    Columns("P:Q").Select 
    Columns("Q:U").Select 
    Selection.Delete Shift:=xlToLeft 
    Columns("U:U").Select 
    ActiveWindow.SmallScroll ToRight:=7 
    Columns("Y:Y").Select 
    ActiveWindow.SmallScroll ToRight:=10 
    Columns("Y:AH").Select 
    Selection.Delete Shift:=xlToLeft 
    Columns("Z:Z").Select 
    ActiveWindow.SmallScroll ToRight:=18 
    Columns("Z:AM").Select 
    Selection.Delete Shift:=xlToLeft 
    ActiveWindow.SmallScroll ToRight:=-21 
    Columns("D:D").Select 
    Selection.Cut 
    Columns("C:C").Select 
    Selection.Insert Shift:=xlToRight 
    Columns("O:O").Select 
    Selection.Cut 
    Columns("F:F").Select 
    Selection.Insert Shift:=xlToRight 
    Columns("Q:Q").Select 
    Selection.Cut 
    Columns("G:G").Select 
    Selection.Insert Shift:=xlToRight 
    Columns("R:R").Select 
    Selection.Cut 
    Columns("H:H").Select 
    Selection.Insert Shift:=xlToRight 
    Columns("R:R").Select 
    Selection.Cut 
    Columns("I:I").Select 
    Selection.Insert Shift:=xlToRight 
    Columns("O:O").Select 
    Selection.Cut 
    Columns("J:J").Select 
    Selection.Insert Shift:=xlToRight 
    Columns("Q:Q").Select 
    Selection.Cut 
    Columns("K:K").Select 
    Selection.Insert Shift:=xlToRight 
    Columns("R:R").Select 
    Selection.Cut 
    Columns("L:L").Select 
    Selection.Insert Shift:=xlToRight 
    Columns("R:R").Select 
    Selection.Cut 
    Columns("M:M").Select 
    Selection.Insert Shift:=xlToRight 
    Columns("N:O").Select 
    Selection.Cut 
    Columns("S:S").Select 
    Selection.Insert Shift:=xlToRight 
    Columns("Y:Y").Select 
    Selection.Cut 
    Columns("U:U").Select 
    Selection.Insert Shift:=xlToRight 
    ActiveWindow.SmallScroll ToRight:=-12 
    Range("A1").Select 
    With ActiveWindow 
        .SplitColumn = 0 
        .SplitRow = 1 
    End With 
    ActiveWindow.FreezePanes = True 
    Cells.Select 
    Cells.EntireColumn.AutoFit 
    Rows("1:1").Select 
    With Selection 
        .HorizontalAlignment = xlCenter 
        .VerticalAlignment = xlBottom 
        .WrapText = False 
        .Orientation = 0 
        .AddIndent = False 
        .IndentLevel = 0 
        .ShrinkToFit = False 
        .ReadingOrder = xlContext 
        .MergeCells = False 
    End With 
    Selection.Font.Bold = True 
    With Selection 
        .HorizontalAlignment = xlCenter 
        .VerticalAlignment = xlBottom 
        .WrapText = True 
        .Orientation = 0 
        .AddIndent = False 
        .IndentLevel = 0 
        .ShrinkToFit = False 
        .ReadingOrder = xlContext 
        .MergeCells = False 
    End With 
    Selection.RowHeight = 119.25 
    Cells.Select 
    Selection.ColumnWidth = 34 
    Cells.EntireColumn.AutoFit 
    Cells.EntireColumn.AutoFit 
    Columns("A:A").Select 
    Selection.ColumnWidth = 18.43 
    Columns("A:A").EntireColumn.AutoFit 
    Columns("F:M").Select 
    Selection.ColumnWidth = 7 
    Selection.ColumnWidth = 5.71 
    Columns("F:M").EntireColumn.AutoFit 
    Columns("N:R").Select 
    Selection.ColumnWidth = 5 
    Columns("N:R").EntireColumn.AutoFit 
    Columns("S:Y").Select 
    Columns("S:Y").EntireColumn.AutoFit 
    Selection.ColumnWidth = 7.14 
    Columns("S:Y").EntireColumn.AutoFit 
    Range("R1").Select 
    ActiveCell.FormulaR1C1 = "Fran $" 
    With ActiveCell.Characters(Start:=1, Length:=6).Font 
        .Name = "Calibri" 
        .FontStyle = "Bold" 
        .Size = 11 
        .Strikethrough = False 
        .Superscript = False 
        .Subscript = False 
        .OutlineFont = False 
        .Shadow = False 
        .Underline = xlUnderlineStyleNone 
        .ThemeColor = xlThemeColorLight1 
        .TintAndShade = 0 
        .ThemeFont = xlThemeFontMinor 
    End With 
    Range("R2").Select 
    Columns("R:R").ColumnWidth = 5 
    Columns("R:R").EntireColumn.AutoFit 
    ActiveWindow.SmallScroll ToRight:=-14 
    Range("B1").Select 
    ActiveCell.FormulaR1C1 = "Mfr Part Number (from Oppslist)" 
    With ActiveCell.Characters(Start:=1, Length:=31).Font 
        .Name = "Calibri" 
        .FontStyle = "Bold" 
        .Size = 11 
        .Strikethrough = False 
        .Superscript = False 
        .Subscript = False 
        .OutlineFont = False 
        .Shadow = False 
        .Underline = xlUnderlineStyleNone 
        .ThemeColor = xlThemeColorLight1 
        .TintAndShade = 0 
        .ThemeFont = xlThemeFontMinor 
    End With 
    Cells.Select 
    ActiveWorkbook.Worksheets(1).Sort.SortFields.Clear 
    ActiveWorkbook.Worksheets(1).Sort.SortFields.Add Key:=Range( _ 
    "B2:B4877"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _ 
    xlSortNormal 
    With ActiveWorkbook.Worksheets(1).Sort 
        .SetRange Range("A1:CF4877") 
        .Header = xlYes 
        .MatchCase = False 
        .Orientation = xlTopToBottom 
        .SortMethod = xlPinYin 
        .Apply 
    End With 
     ' Delete_Blank_Row_Test Macro
     'Columns("B:B").Select
     'Selection.SpecialCells(xlCellTypeBlanks).Select
     'Selection.EntireRow.Delete
     'Range("A2").Select
     ' Delete_Dups_Test Macro
    ActiveSheet.Range("$A$1:$CF$4877").RemoveDuplicates Columns:=Array(1, 19, 20, 23 _ 
    ), Header:=xlNo 
     ' Sort Macro
    Cells.Select 
    ActiveWorkbook.Worksheets(1).Sort.SortFields.Clear 
    ActiveWorkbook.Worksheets(1).Sort.SortFields.Add Key:=Range( _ 
    "A2:A18594"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _ 
    xlSortNormal 
    With ActiveWorkbook.Worksheets(1).Sort 
        .SetRange Range("A1:CF18594") 
        .Header = xlYes 
        .MatchCase = False 
        .Orientation = xlTopToBottom 
        .SortMethod = xlPinYin 
        .Apply 
    End With 
     ' Start Blank IPN Cells Macro
    Columns("C:C").Select 
    Selection.Replace What:="", Replacement:="blank", LookAt:=xlPart, _ 
    SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _ 
    ReplaceFormat:=False 
    Range("A2").Select 
     ' End Blank IPN Cell Macro
     ' Numbering
    Application.DisplayAlerts = False 
    Columns("A:A").Select 
    Selection.Copy 
    Sheets.Add After:=Sheets(Sheets.Count) 
    ActiveSheet.Paste 
    Application.CutCopyMode = False 
    ActiveSheet.Range("$A$1:$A$65000").RemoveDuplicates Columns:=1, Header:=xlNo 
    Range("B2").Select 
     'Range("A2").Select
     'Columns("B:B").Select
     'Range("B2").Activate
     'Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
     'Range("B1").Select
     'ActiveCell.FormulaR1C1 = "CT"
    Range("B2").Select 
    ActiveCell.FormulaR1C1 = "1" 
    Range("B3").Select 
    ActiveCell.FormulaR1C1 = "=R[-1]C+1" 
    Range("B3").Select 
    If IsEmpty(ActiveCell) Then Exit Sub 
    Range(ActiveCell, ActiveCell.Offset(0, -1).End(xlDown).Offset(0, 1)).FillDown 
     'VLookUp Part
    Sheets(2).Select 
    Sheets(2).Name = "Numbers" 
    Sheets(1).Select 
    Columns("B:B").Select 
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove 
    Range("B2").Select 
    ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-1],Numbers!C[-1]:C,2,FALSE)" 
    If IsEmpty(ActiveCell) Then Exit Sub 
    Range(ActiveCell, ActiveCell.Offset(0, -1).End(xlDown).Offset(0, 1)).FillDown 
     'Start Copy Paste Special
    Range("B2").Select 
    Range(Selection, Selection.End(xlDown)).Select 
    Selection.Copy 
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ 
    :=False, Transpose:=False 
    Range("B2").Select 
    ActiveSheet.Paste 
    Application.CutCopyMode = False 
     'Stop Copy Paste Special
    Range("B1").Select 
    ActiveCell.FormulaR1C1 = "#" 
    With ActiveCell.Characters(Start:=1, Length:=1).Font 
        .Name = "Calibri" 
        .FontStyle = "Bold" 
        .Size = 11 
        .Strikethrough = False 
        .Superscript = False 
        .Subscript = False 
        .OutlineFont = False 
        .Shadow = False 
        .Underline = xlUnderlineStyleNone 
        .ThemeColor = xlThemeColorLight1 
        .TintAndShade = 0 
        .ThemeFont = xlThemeFontMinor 
    End With 
    Columns("B:B").Select 
    Selection.Font.Bold = False 
    Selection.Font.Bold = True 
    Columns("B:B").Select 
    Selection.Cut 
    Columns("A:A").Select 
    Selection.Insert Shift:=xlToRight 
    Columns("A:A").EntireColumn.AutoFit 
    Range("A2").Select 
    Sheets("Numbers").Select 
    ActiveWindow.SelectedSheets.Delete 
     ' Border_and_Coloring_Formatting Macro
    Range("A:B,D:F").Select 
    Range("D1").Activate 
    Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _ 
    "=LEN(TRIM(D1))>0" 
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority 
    With Selection.FormatConditions(1).Borders(xlLeft) 
        .LineStyle = xlContinuous 
        .TintAndShade = 0 
        .Weight = xlThin 
    End With 
    With Selection.FormatConditions(1).Borders(xlRight) 
        .LineStyle = xlContinuous 
        .TintAndShade = 0 
        .Weight = xlThin 
    End With 
    With Selection.FormatConditions(1).Borders(xlTop) 
        .LineStyle = xlContinuous 
        .TintAndShade = 0 
        .Weight = xlThin 
    End With 
    With Selection.FormatConditions(1).Borders(xlBottom) 
        .LineStyle = xlContinuous 
        .TintAndShade = 0 
        .Weight = xlThin 
    End With 
    With Selection.FormatConditions(1).Interior 
        .PatternColorIndex = xlAutomatic 
        .Color = 10092543 
        .TintAndShade = 0 
    End With 
    Selection.FormatConditions(1).StopIfTrue = True 
    Columns("G:N").Select 
    Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _ 
    "=LEN(TRIM(G1))>0" 
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority 
    With Selection.FormatConditions(1).Borders(xlLeft) 
        .LineStyle = xlContinuous 
        .TintAndShade = 0 
        .Weight = xlThin 
    End With 
    With Selection.FormatConditions(1).Borders(xlRight) 
        .LineStyle = xlContinuous 
        .TintAndShade = 0 
        .Weight = xlThin 
    End With 
    With Selection.FormatConditions(1).Borders(xlTop) 
        .LineStyle = xlContinuous 
        .TintAndShade = 0 
        .Weight = xlThin 
    End With 
    With Selection.FormatConditions(1).Borders(xlBottom) 
        .LineStyle = xlContinuous 
        .TintAndShade = 0 
        .Weight = xlThin 
    End With 
    With Selection.FormatConditions(1).Interior 
        .PatternColorIndex = xlAutomatic 
        .ThemeColor = xlThemeColorAccent1 
        .TintAndShade = 0.799981688894314 
    End With 
    Selection.FormatConditions(1).StopIfTrue = True 
    Columns("O:S").Select 
    Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _ 
    "=LEN(TRIM(O1))>0" 
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority 
    With Selection.FormatConditions(1).Borders(xlLeft) 
        .LineStyle = xlContinuous 
        .TintAndShade = 0 
        .Weight = xlThin 
    End With 
    With Selection.FormatConditions(1).Borders(xlRight) 
        .LineStyle = xlContinuous 
        .TintAndShade = 0 
        .Weight = xlThin 
    End With 
    With Selection.FormatConditions(1).Borders(xlTop) 
        .LineStyle = xlContinuous 
        .TintAndShade = 0 
        .Weight = xlThin 
    End With 
    With Selection.FormatConditions(1).Borders(xlBottom) 
        .LineStyle = xlContinuous 
        .TintAndShade = 0 
        .Weight = xlThin 
    End With 
    With Selection.FormatConditions(1).Interior 
        .PatternColorIndex = xlAutomatic 
        .ThemeColor = xlThemeColorAccent4 
        .TintAndShade = 0.799981688894314 
    End With 
    Selection.FormatConditions(1).StopIfTrue = True 
    Columns("C:C").Select 
    Range("C:C,T:Z").Select 
    Range("T1").Activate 
    Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _ 
    "=LEN(TRIM(T1))>0" 
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority 
    With Selection.FormatConditions(1).Borders(xlLeft) 
        .LineStyle = xlContinuous 
        .TintAndShade = 0 
        .Weight = xlThin 
    End With 
    With Selection.FormatConditions(1).Borders(xlRight) 
        .LineStyle = xlContinuous 
        .TintAndShade = 0 
        .Weight = xlThin 
    End With 
    With Selection.FormatConditions(1).Borders(xlTop) 
        .LineStyle = xlContinuous 
        .TintAndShade = 0 
        .Weight = xlThin 
    End With 
    With Selection.FormatConditions(1).Borders(xlBottom) 
        .LineStyle = xlContinuous 
        .TintAndShade = 0 
        .Weight = xlThin 
    End With 
    Selection.FormatConditions(1).StopIfTrue = True 
    Range("A2").Select 
     ' Copy Worksheets and Renaming
    Range("A2").Select 
    Sheets(1).Select 
    Sheets(1).Copy After:=Sheets(1) 
    Sheets(2).Select 
    Sheets(2).Copy After:=Sheets(2) 
    Sheets(3).Select 
    Sheets(3).Name = "Pivot Table" 
    Columns("A:A").Select 
    Selection.Delete Shift:=xlToLeft 
    Columns("B:R").Select 
    Selection.Delete Shift:=xlToLeft 
    Columns("D:D").Select 
    Selection.Delete Shift:=xlToLeft 
    Columns("E:E").Select 
    Selection.Delete Shift:=xlToLeft 
    Columns("F:F").Select 
    Selection.Delete Shift:=xlToLeft 
    Range("A2").Select 
    Sheets(2).Select 
    Sheets(2).Name = "Detailed Match" 
    Sheets(1).Select 
    Sheets(1).Name = "Match Summary" 
    Sheets("Match Summary").Select 
    With ActiveWorkbook.Sheets("Match Summary").Tab 
        .Color = 255 
        .TintAndShade = 0 
    End With 
    Columns("C:C").Select 
    Selection.Delete Shift:=xlToLeft 
    Columns("S:S").Select 
    Columns("S:Z").Select 
    Selection.Delete Shift:=xlToLeft 
    Range("A2").Select 
    Application.ScreenUpdating = True 
     ' Removes Dups in Col A in Match Summary Sheet
    Sheets("Match Summary").Select 
    Columns("A:R").Select 
    ActiveSheet.Range("$A$1:$R$65000").RemoveDuplicates Columns:=1, Header:=xlNo 
    Range("A2").Select 
     ' Subtotal Average on Detailed Match Sheet
    Sheets("Detailed Match").Select 
    Selection.Copy 
    Range("A2").Select 
    Application.CutCopyMode = False 
    Columns("A:U").Select 
    Selection.Subtotal GroupBy:=2, Function:=xlAverage, TotalList:=Array(5, 6) _ 
    , Replace:=True, PageBreaks:=False, SummaryBelowData:=True 
    Columns("B:B").Select 
    Selection.Replace What:=" AVerage", Replacement:="", LookAt:=xlPart, _ 
    SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _ 
    ReplaceFormat:=False 
    Sheets("Match Summary").Select 
     'Columns("S:S").Select
     'Selection.Delete Shift:=xlToLeft
    Range("A2").Select 
     ' Pivot Table 1
    ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _ 
    "Pivot Table!R1C1:R1048576C3", Version:=xlPivotTableVersion12). _ 
    CreatePivotTable TableDestination:="", TableName:="PivotTable1" _ 
    , DefaultVersion:=xlPivotTableVersion12 
    With ActiveSheet.PivotTables("PivotTable1").PivotFields( _ 
        "MPN (from Your Customer List)") 
        .Orientation = xlRowField 
        .Position = 1 
    End With 
    ActiveSheet.PivotTables("PivotTable1").AddDataField ActiveSheet.PivotTables( _ 
    "PivotTable1").PivotFields("Listed Qty"), "Count of Listed Qty", xlCount 
    With ActiveSheet.PivotTables("PivotTable1").PivotFields("Count of Listed Qty") 
        .Caption = "Sum of Total Listed Avail. Qty" 
        .Function = xlSum 
    End With 
    ActiveSheet.PivotTables("PivotTable1").AddDataField ActiveSheet.PivotTables( _ 
    "PivotTable1").PivotFields("Listed Cost"), "Count of Listed Cost", xlCount 
    With ActiveSheet.PivotTables("PivotTable1").PivotFields("Count of Listed Cost") 
        .Caption = "Min of Listed Cost" 
        .Function = xlMin 
    End With 
    ActiveSheet.PivotTables("PivotTable1").AddDataField ActiveSheet.PivotTables( _ 
    "PivotTable1").PivotFields("Listed Cost"), "Count of Listed Cost", xlCount 
    With ActiveSheet.PivotTables("PivotTable1").PivotFields("Count of Listed Cost") 
        .Caption = "Max of Listed Cost" 
        .Function = xlMax 
    End With 
    ActiveWorkbook.ShowPivotTableFieldList = False 
    Columns("A:D").Select 
    Selection.Copy 
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ 
    :=False, Transpose:=False 
    ActiveSheet.Paste 
    Application.CutCopyMode = False 
    Rows("1:1").Select 
    Selection.Delete Shift:=xlUp 
    Columns("A:D").Select 
    Selection.Copy 
    Sheets("Match Summary").Select 
    Columns("S:S").Select 
    ActiveSheet.Paste 
    Sheets(1).Select 
    Application.CutCopyMode = False 
    ActiveWindow.SelectedSheets.Delete 
    Sheets("Pivot Table").Select 
    Columns("B:C").Select 
    Selection.Delete Shift:=xlToLeft 
    Range("A2").Select 
     'Delete Dups in Pivot Table
    Sheets("Pivot Table").Select 
    Columns("A:C").Select 
    ActiveSheet.Range("$A$1:$C$65000").RemoveDuplicates Columns:=Array(1, 2, 3), _ 
    Header:=xlNo 
     ' Pivot Table 2
    ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _ 
    "Pivot Table!R1C1:R1048576C3", Version:=xlPivotTableVersion12). _ 
    CreatePivotTable TableDestination:="", TableName:="PivotTable1" _ 
    , DefaultVersion:=xlPivotTableVersion12 
    ActiveWorkbook.ShowPivotTableFieldList = True 
    With ActiveSheet.PivotTables("PivotTable1").PivotFields( _ 
        "MPN (from Your Customer List)") 
        .Orientation = xlRowField 
        .Position = 1 
    End With 
    With ActiveSheet.PivotTables("PivotTable1").PivotFields("A2E Contact") 
        .Orientation = xlColumnField 
        .Position = 1 
    End With 
    ActiveSheet.PivotTables("PivotTable1").AddDataField ActiveSheet.PivotTables( _ 
    "PivotTable1").PivotFields("File#"), "Count of File#", xlCount 
    ActiveWorkbook.ShowPivotTableFieldList = False 
     'Begin Test PT Macro
    With ActiveSheet.PivotTables("Pivottable1") 
        .ColumnGrand = False 
        .DisplayNullString = True 
        .RowGrand = False 
    End With 
    With ActiveSheet.PivotTables("Pivottable1").PivotFields( _ 
        "MPN (from Your Customer List)") 
        .PivotItems("(blank)").Visible = False 
    End With 
     'End Test PT Macro
    Cells.Select 
    Selection.Copy 
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ 
    :=False, Transpose:=False 
    ActiveSheet.Paste 
    Application.CutCopyMode = False 
    Rows("1:1").Select 
    Selection.Delete Shift:=xlUp 
    Range("A1").Select 
    Range(Selection, Selection.End(xlToRight)).Select 
    Range(Selection, Selection.End(xlDown)).Select 
    Selection.Copy 
    Sheets("Match Summary").Select 
    Range("W1").Select 
    ActiveSheet.Paste 
    Sheets(3).Select 
    Application.CutCopyMode = False 
    ActiveWindow.SelectedSheets.Delete 
    Sheets("Match Summary").Select 
     ' Formatting_After_PT Macro
    Columns("B:B").Select 
    Selection.SpecialCells(xlCellTypeBlanks).Select 
    Selection.EntireRow.Delete 
    Columns("S:S").Select 
    Selection.Delete Shift:=xlToLeft 
    ActiveWindow.SmallScroll ToRight:=7 
    Columns("V:V").Select 
    Selection.ClearContents 
    Range("V1").Select 
    ActiveCell.FormulaR1C1 = "Total Excess / LDT Reps Showing Avail" 
    Range("S1:V1").Select 
    With Selection 
        .HorizontalAlignment = xlCenter 
        .VerticalAlignment = xlBottom 
        .WrapText = False 
        .Orientation = 0 
        .AddIndent = False 
        .IndentLevel = 0 
        .ShrinkToFit = False 
        .ReadingOrder = xlContext 
        .MergeCells = False 
    End With 
    Selection.Font.Bold = True 
    With Selection 
        .HorizontalAlignment = xlCenter 
        .VerticalAlignment = xlBottom 
        .WrapText = True 
        .Orientation = 0 
        .AddIndent = False 
        .IndentLevel = 0 
        .ShrinkToFit = False 
        .ReadingOrder = xlContext 
        .MergeCells = False 
    End With 
    Columns("S:S").ColumnWidth = 6.71 
    Columns("T:V").Select 
    Selection.ColumnWidth = 5.43 
    Columns("T:U").Select 
    Columns("T:U").EntireColumn.AutoFit 
    Selection.ColumnWidth = 5.29 
    Range("V1").Select 
    Columns("V:V").ColumnWidth = 8.43 
    Range("I1").Select 
    ActiveCell.FormulaR1C1 = "Res. Qty" 
    With ActiveCell.Characters(Start:=1, Length:=8).Font 
        .Name = "Calibri" 
        .FontStyle = "Bold" 
        .Size = 11 
        .Strikethrough = False 
        .Superscript = False 
        .Subscript = False 
        .OutlineFont = False 
        .Shadow = False 
        .Underline = xlUnderlineStyleNone 
        .ThemeColor = xlThemeColorLight1 
        .TintAndShade = 0 
        .ThemeFont = xlThemeFontMinor 
    End With 
    Range("A2").Select 
     ' Pt Formatting 2
    Range("W1").Select 
    Range(Selection, Selection.End(xlToRight)).Select 
    With Selection 
        .HorizontalAlignment = xlGeneral 
        .VerticalAlignment = xlBottom 
        .WrapText = False 
        .Orientation = 90 
        .AddIndent = False 
        .IndentLevel = 0 
        .ShrinkToFit = False 
        .ReadingOrder = xlContext 
        .MergeCells = False 
    End With 
    Selection.Font.Bold = True 
    ActiveWindow.SmallScroll ToRight:=-15 
    Columns("W:W").Select 
    Range(Selection, Selection.End(xlToRight)).Select 
     'Columns("W:DZ").EntireColumn.AutoFit
    Columns.EntireColumn.AutoFit 
    ActiveWindow.SmallScroll ToRight:=-18 
     ' Delete Pivot Table Sheet Macro
    Sheets("Pivot Table").Select 
    ActiveWindow.SelectedSheets.Delete 
    Sheets("Match Summary").Select 
    Range("A2").Select 
    Application.DisplayAlerts = True 
     ' Macro2 Macro
    Columns("A:A").Select 
    Selection.SpecialCells(xlCellTypeBlanks).Select 
    Selection.EntireRow.Delete 
    Range("S1").Select 
    Range(Selection, Selection.End(xlDown)).Select 
    Range(Selection, Selection.End(xlToRight)).Select 
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone 
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone 
    With Selection.Borders(xlEdgeLeft) 
        .LineStyle = xlContinuous 
        .ColorIndex = 0 
        .TintAndShade = 0 
        .Weight = xlThin 
    End With 
    With Selection.Borders(xlEdgeTop) 
        .LineStyle = xlContinuous 
        .ColorIndex = 0 
        .TintAndShade = 0 
        .Weight = xlThin 
    End With 
    With Selection.Borders(xlEdgeBottom) 
        .LineStyle = xlContinuous 
        .ColorIndex = 0 
        .TintAndShade = 0 
        .Weight = xlThin 
    End With 
    With Selection.Borders(xlEdgeRight) 
        .LineStyle = xlContinuous 
        .ColorIndex = 0 
        .TintAndShade = 0 
        .Weight = xlThin 
    End With 
    With Selection.Borders(xlInsideVertical) 
        .LineStyle = xlContinuous 
        .ColorIndex = 0 
        .TintAndShade = 0 
        .Weight = xlThin 
    End With 
    With Selection.Borders(xlInsideHorizontal) 
        .LineStyle = xlContinuous 
        .ColorIndex = 0 
        .TintAndShade = 0 
        .Weight = xlThin 
    End With 
     ' Macro1 Macro
    Sheets("Detailed Match").Select 
    Columns("B:B").Select 
    Selection.Replace What:="Grand", Replacement:="", LookAt:=xlPart, _ 
    SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _ 
    ReplaceFormat:=False 
    Selection.SpecialCells(xlCellTypeBlanks).Select 
    Selection.EntireRow.Delete 
    ActiveWorkbook.Save 
     ' Format Detail Match Sheet
    Range("A:A,D:D").Select 
    Application.ScreenUpdating = False 
    Selection.SpecialCells(xlCellTypeBlanks).Select 
    Selection.FormulaR1C1 = "=R[-1]C" 
    Range("A1").Select 
     ' Start IPN Macro
    Range("D1").Select 
    Range(Selection, Selection.End(xlDown)).Select 
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone 
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone 
    With Selection.Borders(xlEdgeLeft) 
        .LineStyle = xlContinuous 
        .ColorIndex = 0 
        .TintAndShade = 0 
        .Weight = xlThin 
    End With 
    With Selection.Borders(xlEdgeTop) 
        .LineStyle = xlContinuous 
        .ColorIndex = 0 
        .TintAndShade = 0 
        .Weight = xlThin 
    End With 
    With Selection.Borders(xlEdgeBottom) 
        .LineStyle = xlContinuous 
        .ColorIndex = 0 
        .TintAndShade = 0 
        .Weight = xlThin 
    End With 
    With Selection.Borders(xlEdgeRight) 
        .LineStyle = xlContinuous 
        .ColorIndex = 0 
        .TintAndShade = 0 
        .Weight = xlThin 
    End With 
    With Selection.Borders(xlInsideVertical) 
        .LineStyle = xlContinuous 
        .ColorIndex = 0 
        .TintAndShade = 0 
        .Weight = xlThin 
    End With 
    With Selection.Borders(xlInsideHorizontal) 
        .LineStyle = xlContinuous 
        .ColorIndex = 0 
        .TintAndShade = 0 
        .Weight = xlThin 
    End With 
    With Selection.Interior 
        .Pattern = xlSolid 
        .PatternColorIndex = xlAutomatic 
        .Color = 10092543 
        .TintAndShade = 0 
        .PatternTintAndShade = 0 
    End With 
    Columns("D:D").Select 
    Selection.Replace What:="blank", Replacement:="", LookAt:=xlPart, _ 
    SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _ 
    ReplaceFormat:=False 
     'Stop IPN Macro
     'Application.ScreenUpdating = True
    Range("C:C,G:Z").Select 
    Range("G1").Activate 
    Selection.Replace What:="", Replacement:="blank", LookAt:=xlPart, _ 
    SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _ 
    ReplaceFormat:=False 
    ActiveWindow.SmallScroll ToRight:=-2 
    Range("C1").Select 
    Range(Selection, Selection.End(xlDown)).Select 
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone 
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone 
    With Selection.Borders(xlEdgeLeft) 
        .LineStyle = xlContinuous 
        .ColorIndex = 0 
        .TintAndShade = 0 
        .Weight = xlThin 
    End With 
    With Selection.Borders(xlEdgeTop) 
        .LineStyle = xlContinuous 
        .ColorIndex = 0 
        .TintAndShade = 0 
        .Weight = xlThin 
    End With 
    With Selection.Borders(xlEdgeBottom) 
        .LineStyle = xlContinuous 
        .ColorIndex = 0 
        .TintAndShade = 0 
        .Weight = xlThin 
    End With 
    With Selection.Borders(xlEdgeRight) 
        .LineStyle = xlContinuous 
        .ColorIndex = 0 
        .TintAndShade = 0 
        .Weight = xlThin 
    End With 
    With Selection.Borders(xlInsideVertical) 
        .LineStyle = xlContinuous 
        .ColorIndex = 0 
        .TintAndShade = 0 
        .Weight = xlThin 
    End With 
    With Selection.Borders(xlInsideHorizontal) 
        .LineStyle = xlContinuous 
        .ColorIndex = 0 
        .TintAndShade = 0 
        .Weight = xlThin 
    End With 
    Range("G1").Select 
    Range(Selection, Selection.End(xlToRight)).Select 
    Range("N1").Select 
    ActiveWindow.SmallScroll ToRight:=-5 
    Range("G1:N1").Select 
    Range(Selection, Selection.End(xlDown)).Select 
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone 
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone 
    With Selection.Borders(xlEdgeLeft) 
        .LineStyle = xlContinuous 
        .ColorIndex = 0 
        .TintAndShade = 0 
        .Weight = xlThin 
    End With 
    With Selection.Borders(xlEdgeTop) 
        .LineStyle = xlContinuous 
        .ColorIndex = 0 
        .TintAndShade = 0 
        .Weight = xlThin 
    End With 
    With Selection.Borders(xlEdgeBottom) 
        .LineStyle = xlContinuous 
        .ColorIndex = 0 
        .TintAndShade = 0 
        .Weight = xlThin 
    End With 
    With Selection.Borders(xlEdgeRight) 
        .LineStyle = xlContinuous 
        .ColorIndex = 0 
        .TintAndShade = 0 
        .Weight = xlThin 
    End With 
    With Selection.Borders(xlInsideVertical) 
        .LineStyle = xlContinuous 
        .ColorIndex = 0 
        .TintAndShade = 0 
        .Weight = xlThin 
    End With 
    With Selection.Borders(xlInsideHorizontal) 
        .LineStyle = xlContinuous 
        .ColorIndex = 0 
        .TintAndShade = 0 
        .Weight = xlThin 
    End With 
    With Selection.Interior 
        .Pattern = xlSolid 
        .PatternColorIndex = xlAutomatic 
        .ThemeColor = xlThemeColorAccent1 
        .TintAndShade = 0.799981688894314 
        .PatternTintAndShade = 0 
    End With 
    Range("O1:S1").Select 
    Range(Selection, Selection.End(xlDown)).Select 
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone 
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone 
    With Selection.Borders(xlEdgeLeft) 
        .LineStyle = xlContinuous 
        .ColorIndex = 0 
        .TintAndShade = 0 
        .Weight = xlThin 
    End With 
    With Selection.Borders(xlEdgeTop) 
        .LineStyle = xlContinuous 
        .ColorIndex = 0 
        .TintAndShade = 0 
        .Weight = xlThin 
    End With 
    With Selection.Borders(xlEdgeBottom) 
        .LineStyle = xlContinuous 
        .ColorIndex = 0 
        .TintAndShade = 0 
        .Weight = xlThin 
    End With 
    With Selection.Borders(xlEdgeRight) 
        .LineStyle = xlContinuous 
        .ColorIndex = 0 
        .TintAndShade = 0 
        .Weight = xlThin 
    End With 
    With Selection.Borders(xlInsideVertical) 
        .LineStyle = xlContinuous 
        .ColorIndex = 0 
        .TintAndShade = 0 
        .Weight = xlThin 
    End With 
    With Selection.Borders(xlInsideHorizontal) 
        .LineStyle = xlContinuous 
        .ColorIndex = 0 
        .TintAndShade = 0 
        .Weight = xlThin 
    End With 
    With Selection.Interior 
        .Pattern = xlSolid 
        .PatternColorIndex = xlAutomatic 
        .ThemeColor = xlThemeColorAccent4 
        .TintAndShade = 0.799981688894314 
        .PatternTintAndShade = 0 
    End With 
    Range("T1:Z1").Select 
    Range(Selection, Selection.End(xlDown)).Select 
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone 
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone 
    With Selection.Borders(xlEdgeLeft) 
        .LineStyle = xlContinuous 
        .ColorIndex = 0 
        .TintAndShade = 0 
        .Weight = xlThin 
    End With 
    With Selection.Borders(xlEdgeTop) 
        .LineStyle = xlContinuous 
        .ColorIndex = 0 
        .TintAndShade = 0 
        .Weight = xlThin 
    End With 
    With Selection.Borders(xlEdgeBottom) 
        .LineStyle = xlContinuous 
        .ColorIndex = 0 
        .TintAndShade = 0 
        .Weight = xlThin 
    End With 
    With Selection.Borders(xlEdgeRight) 
        .LineStyle = xlContinuous 
        .ColorIndex = 0 
        .TintAndShade = 0 
        .Weight = xlThin 
    End With 
    With Selection.Borders(xlInsideVertical) 
        .LineStyle = xlContinuous 
        .ColorIndex = 0 
        .TintAndShade = 0 
        .Weight = xlThin 
    End With 
    With Selection.Borders(xlInsideHorizontal) 
        .LineStyle = xlContinuous 
        .ColorIndex = 0 
        .TintAndShade = 0 
        .Weight = xlThin 
    End With 
    Range("C:C,G:Z").Select 
    Range("G1").Activate 
    Selection.Replace What:="blank", Replacement:="", LookAt:=xlPart, _ 
    SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _ 
    ReplaceFormat:=False 
    Columns("G:N").Select 
    Selection.Columns.Group 
    ActiveSheet.Outline.ShowLevels RowLevels:=2 
    Range("A3").Select 
    Sheets(2).Select 
    Sheets(2).Name = "Detailed Match" 
    Sheets("Match Summary").Select 
    Columns("F:M").Select 
    Selection.Columns.Group 
    Columns("A:A").Select 
    Selection.SpecialCells(xlCellTypeBlanks).Select 
    Selection.EntireRow.Delete 
    ActiveWorkbook.Save 
    Sheets(1).Select 
    Sheets(1).Name = "Match Summary" 
    Range("B2").Select 
    Columns("W:W").Select 
    Range(Selection, Selection.End(xlToRight)).Select 
    Selection.Replace What:="", Replacement:="+", LookAt:=xlPart, _ 
    SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _ 
    ReplaceFormat:=False 
    Range("W1").Select 
    Range(Selection, Selection.End(xlToRight)).Select 
    Range(Selection, Selection.End(xlDown)).Select 
    With Selection.Interior 
        .Pattern = xlSolid 
        .PatternColorIndex = xlAutomatic 
        .ThemeColor = xlThemeColorAccent6 
        .TintAndShade = 0.799981688894314 
        .PatternTintAndShade = 0 
    End With 
    Selection.Replace What:="+", Replacement:="", LookAt:=xlPart, _ 
    SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _ 
    ReplaceFormat:=False 
    Sheets("Detailed Match").Select 
    Columns("C:D").Select 
    Selection.Columns.Group 
    Columns("X:X").Select 
    Sheets("Match Summary").Select 
    Columns("C:C").Select 
    Selection.Columns.Group 
    Sheets("Detailed Match").Select 
    Range("A3").Select 
    ActiveSheet.Outline.ShowLevels RowLevels:=0, ColumnLevels:=2 
    ActiveSheet.Outline.ShowLevels RowLevels:=0, ColumnLevels:=1 
    Sheets("Match Summary").Select 
    ActiveSheet.Outline.ShowLevels RowLevels:=0, ColumnLevels:=1 
    Range("B2").Select 
     ' Start IPN Macro
    Range("C1").Select 
    Range(Selection, Selection.End(xlDown)).Select 
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone 
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone 
    With Selection.Borders(xlEdgeLeft) 
        .LineStyle = xlContinuous 
        .ColorIndex = 0 
        .TintAndShade = 0 
        .Weight = xlThin 
    End With 
    With Selection.Borders(xlEdgeTop) 
        .LineStyle = xlContinuous 
        .ColorIndex = 0 
        .TintAndShade = 0 
        .Weight = xlThin 
    End With 
    With Selection.Borders(xlEdgeBottom) 
        .LineStyle = xlContinuous 
        .ColorIndex = 0 
        .TintAndShade = 0 
        .Weight = xlThin 
    End With 
    With Selection.Borders(xlEdgeRight) 
        .LineStyle = xlContinuous 
        .ColorIndex = 0 
        .TintAndShade = 0 
        .Weight = xlThin 
    End With 
    With Selection.Borders(xlInsideVertical) 
        .LineStyle = xlContinuous 
        .ColorIndex = 0 
        .TintAndShade = 0 
        .Weight = xlThin 
    End With 
    With Selection.Borders(xlInsideHorizontal) 
        .LineStyle = xlContinuous 
        .ColorIndex = 0 
        .TintAndShade = 0 
        .Weight = xlThin 
    End With 
    With Selection.Interior 
        .Pattern = xlSolid 
        .PatternColorIndex = xlAutomatic 
        .Color = 10092543 
        .TintAndShade = 0 
        .PatternTintAndShade = 0 
    End With 
    Columns("C:C").Select 
    Selection.Replace What:="blank", Replacement:="", LookAt:=xlPart, _ 
    SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _ 
    ReplaceFormat:=False 
     ' Count Macro
    Columns("W:W").Select 
    Range(Selection, Selection.End(xlToRight)).Select 
    Selection.Replace What:="", Replacement:="+", LookAt:=xlPart, _ 
    SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _ 
    ReplaceFormat:=False 
    Range("V2").Select 
    ActiveCell.FormulaR1C1 = "=COUNT(RC[1]:RC[500])" 
    If IsEmpty(ActiveCell) Then Exit Sub 
    Range(ActiveCell, ActiveCell.Offset(0, -1).End(xlDown).Offset(0, 1)).FillDown 
    Columns("W:W").Select 
    Range(Selection, Selection.End(xlToRight)).Select 
    Selection.Replace What:="+", Replacement:="", LookAt:=xlPart, _ 
    SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _ 
    ReplaceFormat:=False 
    Range("V2").Select 
    Range(Selection, Selection.End(xlDown)).Select 
    Selection.Copy 
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ 
    :=False, Transpose:=False 
    Selection.Font.Bold = True 
    With Selection 
        .HorizontalAlignment = xlCenter 
        .VerticalAlignment = xlBottom 
        .WrapText = False 
        .Orientation = 0 
        .AddIndent = False 
        .IndentLevel = 0 
        .ShrinkToFit = False 
        .ReadingOrder = xlContext 
        .MergeCells = False 
    End With 
    Range("A2").Select 
     ' Delete EMS/OEM Name Column Macro
    Sheets("Detailed Match").Select 
    Columns("X:X").Select 
    Selection.Delete Shift:=xlToLeft 
    Range("B9").Select 
    Sheets("Match Summary").Select 
    Range("B2").Select 
    Application.ScreenUpdating = True 
End Sub 

If you like these VB formatting tags please consider sponsoring the author in support of injured Royal Marines


I have a date Column which will have dates in (from G8 to G2000)
the date format will be dd/mm/yy e.g 01/03/05 is 1st March 2005.
Each line consists of a quotation that we have done.

I would like to have a macro which I can run once a month (or maybe even an automatic on-going update), which will tell me how many quotes are being done each month so that I can produce a graph from the results.
e.g for March 2005 detect the occurences of 03/05 in Column G8 - G2000, for April 2005 detect the occurances of 04/05 etc. etc. It would be nice to go to year 2008

All thoughts / suggestions welcome

Ed

i have three columns (G:I)

G = figure
H = Title
I = Results

I need to get a result count into I

e.g. I6 = sum of values found in cells in Col G of each cell which contains the same name as the title in H6

so that means

each time it finds the same title as in H6 it takes the figure in the cell to its left (col G) adds them up and puts the results into col I

I was mucking about with a counting macro to find how long it would take my PC to could to 10,000

I then decided to try 1,000,000 but types 10,000,000 instead - needless to say it took was going to take some time.

In the end I ended the excel process from task manager - Is there an easier to force VBA to stop?

the error reads "code execution has been interrupted".

the code i am using is from a recorded sorting macro that spans 4 ranges of cells, most of the time the button i have assigned the macro to works, other times i get the error above.

a little insight as to what the workbook does, as it may or may not help, i am pulling from a range off of another workbook, a multitude of vlookups and concactnations as well as list validations are used to make a revolving list of rankings, i have a count macro tied to a forward button and as the user clicks the button the list "moves" forward throughout months, another button is used to "autosort" the list into proper rankings. I think it is a really nifty tool where people can gather trends and rankings over the course of the data (2 years)

but anyway, here is the macro i recorded earlier, any idea as to why i would be getting the error?

Code:
Sub AutoSort()
'
' AutoSort Macro
' Macro recorded 8/22/2007 by jl5327
'

'
    Range("L17:L26").Select
    Range("F17:M26").Sort Key1:=Range("L17"), Order1:=xlDescending, Header:= _
        xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
    Range("L31:L33").Select
    Range("F31:M33").Sort Key1:=Range("L31"), Order1:=xlDescending, Header:= _
        xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
    Range("R17:R26").Select
    Range("Q17:S26").Sort Key1:=Range("R17"), Order1:=xlDescending, Header:= _
        xlNo, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
    Range("R31:R33").Select
    Range("Q31:S33").Sort Key1:=Range("R31"), Order1:=xlDescending, Header:= _
        xlNo, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
    Range("H2:M2").Select
End Sub
I wouldn't mind the issue, but the problem is that i will have multiple users looking at this work book.

Hi all,

Instead of having to select a range then run a macro to count visble cells,
It maybe more practicle for my needs to have the macro detect all ranges given or found and return the count value to a specific cell location either above or below the range for count.

I've been working with this code but yet to get it to return the correct values.
Currently, this is a simple count macro for the found ranges. If the count formula
looks odd to you, it because I was tossing around the idea of it just filling in a count formula for the relative range to I could actually see the range that's being counted.
However, I think I'd prefer it to just return counted range value.

If you can take it a step further to include only visible cells, that would be awesome.

Sub Count()
Dim Cx As Long
Dim lastrow As Long
With Sheets(1)

lastrow = Cells(Rows.Count, 1).End(xlUp).Row
Cx = Cells(2, Columns.Count).End(xlToLeft).Column
MsgBox "Cx= " & Cx
MsgBox "lastrow= " & lastrow
'With Range("G1:Cx" & WorksheetFunction.Max(3, lastrow))
For I = 7 To Cx ' where column G=7 & Cx = Last cell in row 1 with data

' Set FindIt = Sheets(1).Range("G1" & ":" & Cx & "1").Find(what:=Sheets(1).Range("G1" & ":" & Cx & "1").Value)
' If Not FindIt Is Nothing Then
' Cells(1, I).Formula = "= WorksheetFunction.Count" & "(" & """"" & ""3"" & "","" & i & "":"" & LastRow & "","" & i &""""" & ")"
Cells(1, I).Formula = "=Count(" & """"" & ""3,"" & i & "":"" & LastRow & "","" & i &""""" & ")"

' End If

Next I
' End With
End With
'OutPL.Cells(, "R").Value = Cells(i, "I").Value
' Cells(2,findit.Column).Value = WorkSheetFunction.Count(3,Cx:LastRow,Cx)
End Sub
Attached is my test workbook
Any help again is appreciated.
Thanks,

BDB

A friend needs to find the total of all the words in an excel document. Is
there a macro around somewhere that does this?

Thanks,

Jack Crane

I would like to modify the below macro so it only counts a word once even if it appears more than once in a row. The reason I want to do this is so I can get a snapshot of the data without certain terms being over-represented.

For example, in the attached example the word 'Microsoft' appears 5 times in row 4 but I only want this to be counted once. In the whole data set Microsoft appears 20 times but only in 7 of the 20 rows so I would like the count to be 7.

The example is set out as follows: In column B there is a description field which in practice will contain consumer complaints and inquiries. To keep the data anonymous the description is filled out with random words and all other columns are blank. The output of Andy Pope's unique word counting macro appears in I:J.

Sub CreateUniqueWords()
    Dim rngData As Range
    Dim rngCell As Range
    Dim colWords As Collection
    Dim vntWord As Variant
    
    On Error Resume Next
    
    Set colWords = New Collection
    Set rngData = Range("B4:B24")
    For Each rngCell In rngData.Cells
        For Each vntWord In Split(Replace(Replace(Replace(rngCell.Value, """", ""),
"]", ""), "[", ""), " ")
            colWords.Add colWords.Count + 1, vntWord
            With Cells(3 + colWords(vntWord), 9)
                .Value = vntWord
                .Offset(0, 1) = .Offset(0, 1) + 1
            End With
        Next
    Next
    
    With Range("I4", Cells(Rows.Count, 9).End(xlUp)).Resize(, 2)
        .Sort .Cells(1, 2), xlDescending
    End With
    
End Sub
I have been advised by a mod to start a new thread as the goals of my previous thread had changed.

I'm attempting to do two things in an Excel workbook, which I will believe require the use of at least one, if not two macros, but I'm clueless as to how to go about this.

The first step is creating some sort of macro to count cells in one column. The count would always begin at the same cell (A17) of a sheet that will always be titled 'Segments'. The count should begin with a stored variable of 1, and add 1 for every subsequent cell in the column it checks that does not include the words 'Total Revenues'. When it reaches these words, the count should not add 1, and cease counting, saving the variable.

The second step is using the number that the counting macro reached to output the content of the rows 17 to (17+n) into a separate sheet in the workbook. Similarly, I would like to be able to do this not just for column A, but for any number of columns. For example, rows 17 to 17+n for columns A, B, C and D will be copied to another sheet, becoming rows 7 to 7+n, for the same columns.

Overall, the function will:

a) Determine how many rows in Column A contain relevant data
b) Export the data from several columns on the sheet to another parallel sheet, with the correct number of rows

Strictly speaking, this operation could be done without the first step, if I was aware of how to do the second step, but have the number 'n', calculated by the macro, be replaced with a manually input number in a 'variable' cell.

Either way, I'm clueless as to how to do this. Can anyone help? It would be much appreciated.

Thanks in advance!

Hello,

Say I have a row with data in row 3 while my selection is a couple of rows below row 3. (All the cells are empty below row 3)

From my current location, I reach the row 3 and while performing a count of the number of rows elapsed to get to the row with data. After recording this macro manually (using a row count macro ofcourse), this is the code that got generated so far:
Range(Selection, Selection.End(xlUp)).Select 
Application.Run "Results_BW.xls!CountRow" 
Where the code for CountRow is:
Sub CountRow() 
myCountRow = Selection.Rows.Count
All I would like to know is how to get Excel to copy a row a certain number of rows below it, where the number is the row count I just performed.

If there is any need for further clarification then please let me know! Any help is appreciated.

Hi guys,

Currenly I have about 20 reports I run on Monday mornings for the company I work in. Each report I run is presented in excel and contains sheets with SQL queries in them that update from a centralised macro I created.

Each week I copy last weeks workbook and use my update macro to update the workbooks with the new data.

Some workbooks I can't update this way by having the SQL's in the sheets as they are too big to make into single queries so I've had to break the queries down to use volatile tables. I can only running these in Queryman and then manually paste the data into the workbooks.

What I want to do is have one all awesome macro that runs the reports after a certain time on Monday morning. So effectively I'll leave my computer on on Friday night and come Monday morning at around 3-4am it will copy all of last weeks workbooks and save with this weeks dates. Then I want it to open each one and update it and save it once the update is done then open Teradata Queryman for all the remaining queries and run them in there so that when I get in on Monday morning all I have to do is copy and paste the manual stuff and get the reports out a whole lot sooner also saving myself an hour worth of doing this manually.

Any help would be appreciated. Even a simple time counting macro that only runs data after a certain time on a certain day/date would be a good start.

           


Sub count()
'
' count Macro
'
' Keyboard Shortcut: Ctrl+Shift+Y
'
Dim n, J, unit, count As Integer   'variable for changing sheets
n = 2
J = 2
Dim layout As Worksheet         ' setting sheet dimensions
Dim dat As Worksheet         'setting sheet referencce
Set layout = Sheets("layout")         'defining specific sheet reference
Sheets("layout").Parent.Activate        ' opening main excel spreadsheet
Dim Result As Long
Dim strgName, class As String

''''''''''''''''''''''''''''''''''MAIN'''''''''''''''''''''''''''''''''''''''''


    Set dat = Sheets(n)  ' defines reference to data sheets
    For I = 3 To 10000000
                 layout.Select
                layout.Activate
                ThisWorkbook.Activate     'kept getting 1004 error so i had to call the sheet and activate it to have focus
                Range("A" & I).Select
                  Val1 = ActiveCell.Value  ' this value stores the specific cell. this was done because of 1004 error
          
                If Val1 = "" Then
                    Exit For
                End If   ' if there is no value in that cell it will just copy and paste data value

                            dat.Select
                           dat.Activate
                        strgName = ActiveSheet.Name
                         unit = Len(strgName)
                         unit = unit + 1
                        class = Mid(strgName, unit, 4)
          Do
     Result = Range("I" & J).Interior.ColorIndex
                   If Result <> 2 Then
                    If objName <> 0 Then
                   
                      If class = " no " Then
                        layout.Select
                        layout.Activate
                        ThisWorkbook.Activate     'kept getting 1004 error so i had to call the sheet and activate it to have
focus
                        Range("F" & I).Select
                        ActiveCell.Value = objName
                      End If
                     If class = " 'A'" Then
                        layout.Select
                        layout.Activate
                        ThisWorkbook.Activate     'kept getting 1004 error so i had to call the sheet and activate it to have
focus
                        Range("B" & I).Select
                        ActiveCell.Value = objName
                      End If
                      If class = " 'B'" Then
                        layout.Select
                        layout.Activate
                        ThisWorkbook.Activate     'kept getting 1004 error so i had to call the sheet and activate it to have
focus
                        Range("C" & I).Select
                        ActiveCell.Value = objName
                      End If
                      If class = " 'C'" Then
                        layout.Select
                        layout.Activate
                        ThisWorkbook.Activate     'kept getting 1004 error so i had to call the sheet and activate it to have
focus
                        Range("D" & I).Select
                        ActiveCell.Value = objName
                      End If
                      If class = " 'D'" Then
                        layout.Select
                        layout.Activate
                        ThisWorkbook.Activate     'kept getting 1004 error so i had to call the sheet and activate it to have
focus
                        Range("E" & I).Select
                        ActiveCell.Value = objName
                      End If
                        strgName = ActiveSheet.Name
                         unit = Len(strgName)
                         unit = unit + 1
                        class = Mid(strgName, unit, 4)

                  End If
              If Val2 = "" Then
                    Exit Do                 ' when the data column is empty it will exit for and probably go to the next
sheet
                End If
               
               If Val1 = Val2 Then
                     objName = objName + 1
               End If
                  J = J + 1
                  
           Loop
    
    Next I
n = n + 1
End Sub

My problem is that class variable doesnt return any values when i try outputting it on a cell. my goal is to compare its value to the ones specified in the IF statements to see if that part of text exists within the cell. If somebody could help me it would be appreciated. I have attached all my code, what i am doing is counting the amount of times val1 is repeated within the second spreadsheet. the counter ( objName) is supposed to be seperated based on the different class values.

I have two worksheets Sheet1 with up to 6000 rows of data and Sheet2 a de-duped summary of that data.

In Column N of Sheet1 and Sheet2 there are codes

Can anyone suggest a nacro that will start In N2 of Sheet 2 and find the number of occurences of that code in Sheet1?

The codes are mainly groups of between 1 and 5 letters but there are a few alphanumeric as well.

I have changed how I want to go about doing this. Progress indicator is no longer required. See this post.

Hi there,

I am wanting to count and create a tag cloud for unique keywords on a data set that has 20,000 complaints on seperate rows by using something like a word frequency count macro (pivot table is not necessary) and chandoos tag cloud script with the following modifcations:

1. If a word appears multiple times in one row it should only be counted once.

2. Because the data set is so large (at least 200,000 words) I would like keywords only to be displayed if they match certain user defined criteria:
a) They aren't an 'excluded keyword' such as 'and, this, that, they etc'
b) The keyword appears at least x or more times.

3. As theses script/s take a long time to run on such a large dataset I would like to include a progress indicator.

What would be the best way to do this?

Thanks so much for your help. I'm new here and if you want me to clarify anything please ask.

3051CD2A02A1AHBE5M5J3CNT1 2 3051CD2A02A1AM5E5S5CN 1 3051CD2A02A1AS5E5M5CN 1

I need help making a Macro that finds matching data in a column and counts them. In the pivot table shown above, the highlighted numbers should be the exact same, but a couple of numbers and letters are switched around, so they are counted as 1 each instead of having one line of 2. Any help with finding a working Macro for this would be appreciated.

Hi. Going to need more help
I am attaching a picture of what I am working on.

First column (A) have Patient IDs, with ID 1 from row 1 - 130 and ID 2 from 131 - 145 as you can see. This column is always sorted.

It is just an example, the actual sheet will include way more than just 2.

Is there a way to count(or not), find first row and last row of a specific Patient ID.

For example, the macro asks for the patient ID, the answers are first row and last row for that specific Patient ID

Thanks in advance


No luck finding an answer? You could always try Google.