Solved: Filter problem

[justdriving]

After opening attached excel file, I was expecting output to include Columns as given in Yellow Region. But, Output included all irrelevant columns, as shown in Green Column. How can it include only 5 Columns as displayed in yellow column of attachment.

[vba]
Private Sub AiM()

Dim lastRowA, lastColAi, lastRowAi, lastColAim As Long

With Sheets(1)

.Activate
lastRowA = .Cells(.Rows.Count, 1).End(xlUp).Row
lastColAi = .Cells(1, 1).End(xlToRight).Column
lastRowAi = .Cells(.Rows.Count, lastColAi + 5).End(xlUp).Row

With .Range("A1")
.AutoFilter
.AutoFilter Field:=5, Criteria1:="S1"
.AutoFilter Field:=10, Criteria1:="=Yes", Operator:=xlOr, Criteria2:="="
.Resize(lastRowA, 10).Copy
.Offset(lastRowAi + 2, lastColAi + 4).Value = "Pending"
.Offset(lastRowAi + 2, lastColAi + 4).PasteSpecial Paste:=xlPasteFormats
.Offset(lastRowAi + 4, lastColAi + 4).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
.AutoFilter
End With

lastColAim = .Cells(lastRowAi + 5, Columns.Count).End(xlToLeft).Column
.Range(Cells(lastRowAi + 3, lastColAi + 5), Cells(lastRowAi + 3, lastColAim)).Merge
.Range(Cells(lastRowAi + 3, lastColAi + 5), Cells(lastRowAi + 3, lastColAim)).Font.Size = 15
.Range(Cells(lastRowAi + 3, lastColAi + 5), Cells(lastRowAi + 3, lastColAim)).Font.Bold = True
.Range(Cells(lastRowAi + 3, lastColAi + 5), Cells(lastRowAi + 3, lastColAim)).Font.ColorIndex = 6

.Cells.Select
.Cells.EntireRow.AutoFit
End With


Application.CutCopyMode = False

End Sub
[/vba]

[justdriving]

Also, is it possible that first column of Output show each variant once, instead of repeating itself over rows?

[Bob Phillips]

Change AiM to Workbook_Open

[justdriving]

Hi Bob, requesting further assistance.

[Bob Phillips]

Such as what? Did you tried what I suggested?

[justdriving]

I was expecting output to include Columns as given in Yellow Region. But, Output included all irrelevant columns, as shown in Green Column. How can it include only 5 Columns as displayed in yellow column of attachment.

Bob, I thank that you are trying to help me. I know this problem is not so difficult for you.

By Changing AiM to Workbook_Open did not solve the problem.

[Bob Phillips]

[vba]

Private Sub AiM()

Dim lastRowA, lastColAi, lastRowAi, lastColAim As Long

With Sheets(1)

.Activate
lastRowA = .Cells(.Rows.Count, 1).End(xlUp).Row
lastColAi = .Cells(1, 1).End(xlToRight).Column
lastRowAi = .Cells(.Rows.Count, "A").End(xlUp).Row

With .Range("A1")

.AutoFilter
.AutoFilter Field:=5, Criteria1:="S1"
.AutoFilter Field:=10, Criteria1:="=Yes", Operator:=xlOr, Criteria2:="="
.Resize(lastRowA, 4).Copy
With .Offset(lastRowAi + 2, lastColAi + 4)

.PasteSpecial Paste:=xlPasteFormats
.PasteSpecial Paste:=xlPasteAll
End With

.Offset(0, 9).Resize(lastRowAi).Copy
.Offset(lastRowAi + 2, lastColAi + 8).PasteSpecial Paste:=xlPasteAll

.AutoFilter
End With

lastColAim = .Cells(lastRowAi + 5, Columns.Count).End(xlToLeft).Column
With .Range(.Cells(lastRowAi + 1, lastColAi + 5), .Cells(lastRowAi + 1, lastColAim))

.Cells(1, 1).Value = "Pending"
.Interior.ColorIndex = 43
.HorizontalAlignment = xlCenterAcrossSelection
.Font.Size = 15
.Font.Bold = True
.Font.ColorIndex = 6
End With

.Cells.EntireRow.AutoFit
End With

Application.CutCopyMode = False

End Sub[/vba]

[justdriving]

That's reason, I was assured you will solve this. This reply helped me to get idea on how you made it. I thank you many times and I am sincerely looking forward to assist you.