Creating a Count Column

[RedMonkey]

Important Background: I am in the process of emulating a daily process using VBA, the caveat is I am making sure the entire process looks like all the steps I normally take. This is not nearly as effcient as I have found VBA can be but I am trying to remove the fear response my office has for the word "MACRO" (ominous music). They will learn it isn't voodoo and I can get to the point of really saving time/ioncreasing accuracy on other items.

So after creating pivotTables, formatting columns and learning a bunch of goodies from the board I am now at this point. (Sorry I still cannot use special software on this comp to make a nice chart for the board)

A B C D
Sum of Amount Gross
Purchase order Invoice No. Due Date Total
12584 19055E 8/18/2011 3,400.51
45896 39499E 8/19/2011 508.96
0 58954L 9/5/2011 1,100.00
0 8965E 9/3/2011 65.20
856896 11589L 8/30/2011 181.19

This represents the top section of the pasted values from a PivotTable.
What I am trying to do is create a Column E called COUNT that places a "1" next to every Item in Column D that has a actual total so it will skip the top blank row and the "Total" header. This wil be used for yet another PivotT

I've tried more complex ideas (and searched the heck out of this board) to recognize only the number values in D but realized I have never simply created any column with a set value based on any criteria in VBA. So starting over I am at the point below and Cannot get any version of it to work:

'Create the COUNT Column
LR = Range("D2" & Rows.Count).End(xlUp).Row
With Range("E2:E" & LR).Value = 1
End With

Any advice is appreciated.

 

[njimack]

You don't need a utility to post VBA - just copy the code and paste it here, making sure you wrap it in code tags

[CODE]your code here [/CODE]

 

[RedMonkey]

Well here is the little devil up to the previous stopping point, you'll see different column references because I wanted to keep it simple for my inital question.

Sub FIRST()
'
'Formatting, Filtering and Inital PivotTable Macro
'
'
'Vlookup against Disc Vendors and removing all N/A results
'IMPORTANT: If the Disc Vendor Master Data shrinks/grows you need to change the lookup below to match the range.
'There is a more efficient method for this, replace in time
    Sheets("Inv Original").Select
    Columns("B:B").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("B2").Select
    ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-1],'Disc Vend'!R2C1:R116C1,1,FALSE)"
    Selection.AutoFill Destination:=Range("B2:B477")
    Columns("B:B").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Dim i As Long, lr As Long
    lr = Range("B" & Rows.Count).End(xlUp).Row
    For i = lr To 1 Step -1
        With Range("B" & i)
            If .Text = "#N/A" Then .EntireRow.Delete
        End With
    Next i
    Columns("B:B").Select
    Selection.Delete Shift:=xlToLeft
'Change Col D to Funds and other Columns to Simple Number
    Range("D:D").NumberFormat = "###,###.00"
'Change imported text to simple number via Text to Columns, Default Parameteres are removed
    Range("F:F, N:N").NumberFormat = "0"
'Change three consecutive columns to short date format
    Range("I:K").NumberFormat = "m/dd/yyyy"
'Autofilter InputBox for Due date range for Advanced Filter
    Dim Filtercriteria
    Range("A:N").Select
    Selection.AutoFilter
    FilterCriteria1 = InputBox(Prompt:="What is the Start Date?", Title:="Business Date Before Today's Date", Default:="")
    FilterCriteria2 = InputBox(Prompt:="What is the End Date?", Title:="5 Calendar Days After Today's Date", Default:="")
    Selection.AutoFilter Field:=10, Criteria1:=">=" & FilterCriteria1, Criteria2:="<=" & FilterCriteria2
'Select the needed columns, pastes the copied data where needed and format it
'This is from a recording and can be made more elegant?
    Sheets("Inv Original").Select
    Range("B:B,C:C,D:D,F:F,J:J,N:N").Select
    Selection.EntireColumn.Copy _
    Destination:=Sheets("Inv Summary").Range("A1")
    Sheets("Inv Summary").Select
    Range("B:B,C:C,D:D,F:F,J:J,N:N").Select
    With Selection.EntireColumn.AutoFit
    End With
'Pivotable Procedure DIMs
    Dim WSD As Worksheet
    Dim PTCache As PivotCache
    Dim PF As PivotField
    Dim PT As PivotTable
    Dim PRange As Range
    Dim FinalRow As Long
    Dim FinalCol As Long
    Set WSD = Worksheets("Inv Summary")
    For Each PT In WSD.PivotTables
        PT.TableRange2.Clear
    Next PT
'Data Input Area and final steps
    FinalRow = WSD.Cells(Application.Rows.Count, 1).End(xlUp).Row
    FinalCol = WSD.Cells(1, Application.Columns.Count). _
        End(xlToLeft).Column
    Set PRange = WSD.Cells(1, 1).Resize(FinalRow, FinalCol)
    Set PTCache = ActiveWorkbook.PivotCaches.Add(SourceType:= _
        xlDatabase, SourceData:=PRange)
    Set PT = PTCache.CreatePivotTable(TableDestination:=WSD. _
        Cells(1, FinalCol + 2), TableName:="Summary Data")
    PT.ManualUpdate = True
'Set up the row & column fields
    PT.AddFields RowFields:=Array("PurchaseOrder", "VendorInvoiceNumber", "Due Date")
    With PT.PivotFields("AmountGross")
        .Orientation = xlDataField
        .Function = xlSum
        .Position = 1
    End With
'Formats the columns, sets Tabular forms and removes Sub/Grand totals
    PT.ColumnGrand = False
    PT.RowGrand = False
    On Error Resume Next
        For Each PT In frm1.PivotTable.ActiveView
        For Each PF In PT.PivotFields
        PF.Subtotals(1) = True
        PF.Subtotals(1) = False
    Next PF
    Next PT
    PT.ManualUpdate = False
    PT.ManualUpdate = True
    Range("H:K").Select
    With Selection.EntireColumn.AutoFit
    End With
'Copy the PivotTable data over using values
    Range("H:K").Copy
    Range("M:P").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    With Selection.EntireColumn.AutoFit
    End With
'Create range and fill blanks with upper cells, Format PO and Totals
    lr = Range("M" & Rows.Count).End(xlUp).Row
    With Range("M2:M" & lr)
        .SpecialCells(xlCellTypeBlanks).FormulaR1C1 = "=R[-1]C"
        .Value = .Value
    End With
    Columns("M:M").NumberFormat = "0"
    Columns("O:O").NumberFormat = "m/dd/yyyy"
    Columns("P:P").NumberFormat = "###,###.00"
'Create the COUNT Column
    Columns("P:P").SpecialCells(xlCellTypeConstants, 1).Offset(, 1).Value = 1
    Columns("Q:Q").NumberFormat = "0"
    Range("Q2").Select
    ActiveCell.FormulaR1C1 = "Count"