Hi
The whole code is looking up a whole sheet and summing it up for a pivot table. What i would like to achieve is to exclude the rows with specific TEXT in it.
I think it should be specified here. The word: EXCLUDED always can be found in column A
With ActiveSheet
URow = .Columns(1).Find(what:="*", after:=.Cells(1), LookAt:=xlPart, LookIn:=xlFormulas, _
SearchOrder:=xlByRows, SearchDirection:=xlPrevious, MatchCase:=False).Row
End With
Can it be changed to exclude if text is EXCLUDED.
Or is there a way to seperate those cells with: what"*" or Lookin?
Here is the whole code maybe it's usefull:
Sub StO_Pivot(WsSheet As String)
Dim PivotName As String, HeaderArr, Cnt, Cnt1, Cnt2
Dim URow
Application.ScreenUpdating = False
Sheets(WsSheet).Activate
With ActiveSheet
URow = .Columns(1).Find(what:="*", after:=.Cells(1), LookAt:=xlPart, LookIn:=xlFormulas, _
SearchOrder:=xlByRows, SearchDirection:=xlPrevious, MatchCase:=False).Row
End With
Range("H2").Select
ActiveCell.FormulaR1C1 = "=RC[-2]*RC[-1]"
Selection.AutoFill Destination:=Range("H2:H" & URow)
Range("H2:H" & URow).Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("F2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Columns("H:H").ClearContents
Application.CutCopyMode = False
Range("D2").Select
Selection.EntireColumn.Insert
Columns("H:H").Select
Selection.Cut Destination:=Columns("D:D")
HeaderArr = Array("Kontener", "BTSZ", "Megnevezes", "DB", "N.W.", "G.W.", "Price")
For Cnt = 1 To UBound(HeaderArr)
Cells(1, Cnt) = HeaderArr(Cnt)
Next
PivotName = "StoreOut"
Range("A1:G" & URow).Select
Application.CutCopyMode = False
ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
ActiveSheet.Name & "!A1:G" & URow, Version:=xlPivotTableVersion14).CreatePivotTable _
TableDestination:=ActiveSheet.Range("A" & URow + 3), TableName:=PivotName, DefaultVersion _
:=xlPivotTableVersion14
ActiveSheet.PivotTables(PivotName).HasAutoFormat = False
For Cnt1 = 1 To UBound(HeaderArr) - 4
With ActiveSheet.PivotTables(PivotName).PivotFields(HeaderArr(Cnt1))
.Orientation = xlRowField
.Position = Cnt1
End With
Next
For Cnt2 = Cnt1 To UBound(HeaderArr)
With ActiveSheet
.PivotTables(PivotName).AddDataField ActiveSheet.PivotTables( _
PivotName).PivotFields(HeaderArr(Cnt2)), HeaderArr(Cnt2) & "_", xlSum
.PivotTables(PivotName).PivotFields(HeaderArr(Cnt2) & "_").NumberFormat = IIf(Cnt2 = 4, "0", "0.00000")
End With
Next
With ActiveSheet.PivotTables(PivotName)
.ColumnGrand = True 'false
.InGridDropZones = True
.ShowDrillIndicators = False
.SortUsingCustomLists = False
.RowAxisLayout xlTabularRow
End With
Dim FalseArr, FalseArr1
ReDim FalseArr(UBound(ActiveSheet.PivotTables(PivotName).PivotFields(HeaderArr(1)).Subtotals))
For Cnt2 = 1 To UBound(ActiveSheet.PivotTables(PivotName).PivotFields(HeaderArr(1)).Subtotals)
FalseArr(Cnt2) = False
Next
ActiveSheet.PivotTables(PivotName).PivotFields(HeaderArr(1)).Subtotals = FalseArr
ActiveSheet.PivotTables(PivotName).PivotFields(HeaderArr(1)).RepeatLabels = True
ReDim FalseArr1(UBound(ActiveSheet.PivotTables(PivotName).PivotFields(HeaderArr(2)).Subtotals))
For Cnt2 = 1 To UBound(ActiveSheet.PivotTables(PivotName).PivotFields(HeaderArr(2)).Subtotals)
FalseArr1(Cnt2) = False
Next
ActiveSheet.PivotTables(PivotName).PivotFields(HeaderArr(2)).Subtotals = FalseArr1
ActiveSheet.PivotTables(PivotName).PivotFields(HeaderArr(2)).RepeatLabels = True
With ActiveSheet.PivotTables(PivotName).PivotFields("Price_")
.Caption = "Price_"
.Function = xlSum
.NumberFormat = "0.0000"
End With
ActiveSheet.PivotTables(PivotName).PivotSelect ""
Selection.Font.Size = 12
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Rows(URow + 3).ClearContents
Rows(URow + 4).Replace what:="_", Replacement:=""
ActiveSheet.ListObjects.Add(xlSrcRange, Range("$A$" & URow + 4 & ":$G$" _
& ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row), xlNo).Name = "Dummy"
ActiveSheet.ListObjects("Dummy").TableStyle = "TableStyleMedium9"
Application.CutCopyMode = False
Rows("2:" & URow).EntireRow.Hidden = True
Rows("1").ClearContents
[A1].Select: [A1].Value = UCase(CStr(WsSheet))
[F1] = Date: [G1].Value = IIf(UCase(CStr(WsSheet)) = UCase("Kitár"), StockSheet.Range(Evaluate_Col & "2").Value, "")
Call AddButton
Columns("A:G").EntireColumn.AutoFit
'Application.ScreenUpdating = True
End Sub
Bookmarks