Codes Need to be Concise

[ayazgreat]

Sir Vog-II/Jindon

I have written mentioned below codes to copy data with certain craiteria can you please see them if these codes need to be improved or concise.

Sub ayazgreat()
 Dim Header
 Dim Header2
 Dim LastRow As Long
 Dim Rng As Range
 Header = Array("Region", "Item Issued", "Invoice Date", "Cheque #", "Amount", "Chq Date")
 Header2 = "Total"
  With Application
.ScreenUpdating = False
.DisplayAlerts = False
    Sheets("Payment").Copy
    ActiveSheet.Shapes("Button 1").Delete
    ActiveSheet.Shapes("Button 2").Delete
    Rows("1:2").Delete Shift:=xlUp
    ActiveSheet.Range("C3:H3").Value = Header
    ActiveSheet.Columns("E:H").AutoFit
    
    LastRow = Range("A" & Rows.Count).End(xlUp).Row
    Set Rng = Range("A3:H" & Range("A" & Rows.Count).End(xlUp).Row)
    
    Range("A" & LastRow, "H" & LastRow).Delete
    Rng.Sort Key1:=Range("C4"), Order1:=xlAscending
    Rng.AutoFilter Field:=3, Criteria1:="S-II"
    Rng.SpecialCells(xlCellTypeVisible).Copy _
    Destination:=Sheets("Payment").Range("J3")
    Rng.AutoFilter
    
     LastRow = Range("J" & Rows.Count).End(xlUp).Row
     Range("J" & LastRow + 1, "O" & LastRow + 1).Merge
     Range("J" & LastRow + 1) = Header2
     Range("J" & LastRow + 1, "Q" & LastRow + 1).Interior.Color = 0
     Range("J" & LastRow + 1, "Q" & LastRow + 1).Font.Bold = True
     Range("J" & LastRow + 1, "Q" & LastRow + 1).Font.ColorIndex = 2
     Range("J" & LastRow + 1, "O" & LastRow + 1).HorizontalAlignment = xlCenter
     Range("P" & LastRow + 1).Value = WorksheetFunction.Sum(Range("P4:P" & LastRow))
     
     
     
     Rng.AutoFilter Field:=3, Criteria1:="S-III"
     Rng.SpecialCells(xlCellTypeVisible).Copy _
     Destination:=Sheets("Payment").Range("S3")
     Rng.AutoFilter
   
     LastRow = Range("S" & Rows.Count).End(xlUp).Row
     Range("S" & LastRow + 1, "X" & LastRow + 1).Merge
     Range("S" & LastRow + 1) = Header2
     Range("S" & LastRow + 1, "Z" & LastRow + 1).Interior.Color = 0
     Range("S" & LastRow + 1, "Z" & LastRow + 1).Font.Bold = True
     Range("S" & LastRow + 1, "Z" & LastRow + 1).Font.ColorIndex = 2
     Range("S" & LastRow + 1, "X" & LastRow + 1).HorizontalAlignment = xlCenter
     Range("Y" & LastRow + 1).Value = WorksheetFunction.Sum(Range("Y4:Y" & LastRow))
     Range("S3:Z2000").Copy
     Cells(Rows.Count, "J").End(xlUp).Offset(3).PasteSpecial xlAll
     Columns("S:Z").Delete
     Columns("A:I").Delete
     
    Range("A4").Select
.ScreenUpdating = True
.DisplayAlerts = True
End With
End Sub

 

[ayazgreat]

Anyother one can please see it?

Thanks in advance

 

[ayazgreat]

Can anyone please help me in this regard?

Thanks in advance

 

[ayazgreat]

Is there anyone to please help?

 

[Datsmart]

ADVERTISEMENT

Since I do not have access to your data, it is very difficult to give you any advice on your code.

Does it do what you want it to?
Are you getting any errors?

I have viewed some of your other threads and they are equally vague without a specific question.
Please ask your question differently and you should get a better response.

 

[ayazgreat]

Thanks Sir for your reply I have written first time a long macro or u can say that it is my first attempt I want to ask that given codes are possible to be concise and check however these do not give any error.

 

[ayazgreat]

ADVERTISEMENT

Since I do not have access to your data, it is very difficult to give you any advice on your code.

Then who will answer it ?

 

[tusharm]

Well, I did. Then, I noted you wanted advice only from 2 specific individuals. So, I deleted my post.

Then who will answer it ?

 

[ayazgreat]

Thank you very much Sir and it is my good luck that i have got chance to talk to you because I have learnt lots from your site and have been still learing and trying to understand your gievn examples and studies cases but I must appreciate your efforts.

 

[Simon Lloyd]

Ayazgreat posts in many forums and is as vague in those! VBA Express, Ozgrid, Excel Forum etc.