Remove the * from the SubCate, Custom Sort, Replace..Help Please - I need. Thanks
Please help me with the following code. I dont know what am doing wrong. I recorded the following and when I ran it, it was good but I notice that when I rerun it - it messes up the data. I am thinking I should put "if no replacement then dont rerun in the code. Or could it be the Sorting part or do I need the loop. I am not too good with Programming element. All help in helping me straighten out the code to run perfectly all the time regardless of how many times ran would be appreciated. Thanks much
The code below is to;
Remove the * from the Data, Custom Sort, Replace Actions with right wordings, to refresh all pivot table in my worksheets and autofit all cells.
' Here am trying to remove the * from the data but when I just want to replace * it wipes out all the data so did it as shown below. Any help to streamline this will be helpful.
Sub Code ()
Sheets("DATA").Select
Columns("F:F").Select
Selection.Replace What:="*Apple", Replacement:="Apple", LookAt _
:=xlPart, SearchOrder:=xlByColumns, MatchCase:=False, SearchFormat:= _
False, ReplaceFormat:=False
Selection.Replace What:="*Banana", Replacement:= _
"Banana", LookAt:=xlPart, SearchOrder:=xlByColumns, MatchCase _
:=False, SearchFormat:=False, ReplaceFormat:=False
Selection.Replace What:="*Discount", Replacement:="Discount", LookAt _
:=xlPart, SearchOrder:=xlByColumns, MatchCase:=False, SearchFormat:= _
False, ReplaceFormat:=False
Selection.Replace What:="*Fruits", Replacement:= _
"Fruits", LookAt:=xlPart, SearchOrder:=xlByColumns, MatchCase:= _
False, SearchFormat:=False, ReplaceFormat:=False
Selection.Replace What:="*Papaya", Replacement:="Papaya" _
, LookAt:=xlPart, SearchOrder:=xlByColumns, MatchCase:=False, _
SearchFormat:=False, ReplaceFormat:=False
Selection.Replace What:="*Tomatoes", Replacement:="Tomatoes", LookAt:=xlPart, _
SearchOrder:=xlByColumns, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Selection.Replace What:="*Sprite", Replacement:= _
"Sprite", LookAt:=xlPart, SearchOrder:=xlByColumns, _
MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
Selection.Replace What:="*Serious", Replacement:= _
"Serious", LookAt:=xlPart, SearchOrder:=xlByColumns, _
MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
'To Custom Sort the Subcateg in the right order needed in the Reports
ActiveWorkbook.Worksheets("DATA").Sort.SortFields. Clear
ActiveWorkbook.Worksheets("DATA").Sort.SortFields. Add Key:=Range("F2:F451"), _
SortOn:=xlSortOnValues, Order:=xlAscending, CustomOrder:= _
"Apple,Discount,Banana,Tomatoes,Papaya,fruits,Spri te,Serious" _
, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("DATA").Sort
.SetRange Range("F1:F451")
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
'To find and replace Actions to Standard Wording for Report.
Columns("N:N").Select
Selection.Replace What:="Coach", Replacement:= _
"Coaches", LookAt:=xlPart, SearchOrder:=xlByColumns, _
MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
Selection.Replace What:="Coached", Replacement:= _
"Coaches", LookAt:=xlPart, SearchOrder:=xlByColumns, _
MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
Selection.Replace What:="Ignore", Replacement:= _
"Participate", LookAt:=xlPart, SearchOrder:=xlByColumns, _
MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
Selection.Replace What:="Ignored", Replacement:= _
"Participate", LookAt:=xlPart, SearchOrder:=xlByColumns, _
MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
Selection.Replace What:="None", Replacement:="Not Issued", LookAt:= _
xlPart, SearchOrder:=xlByColumns, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Selection.Replace What:="Change", Replacement:= _
"Changes Daily", LookAt:=xlPart, SearchOrder:=xlByColumns, _
MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
'To select the first cell
Range("A1").Select
'This refreshes all Pivot Table Element for Report
ActiveWorkbook.RefreshAll
'To auto format fit all the sheet.
Sheets("SLIDE_2").Select
Cells.Select
'Range("A7").Activate
Cells.EntireColumn.AutoFit
End Sub
|