You spent lots of time in structuring the CDNR sheet for future working. It easy for 1 time, took more time if you have 2 sheets but if you have more than 5 sheets then this trick helps you in time-saving and from machine work.
FOR SAFETY: Apply it on duplicate ,not in original.
It simple and easy
Here are the steps :
 |
| Press ALT +F11 |
 |
| insert new module |
 |
| copy the code and paste in module |
Sub vir()
Application.ScreenUpdating =false
Rows("1:4").Select
Range("O1").Activate
Selection.Delete Shift:=xlUp
ActiveSheet.Shapes.Range(Array("Picture 1")).Select
Selection.Delete
Range("C1:F1").Select
Selection.ClearContents
Range("J1:M1").Select
Selection.ClearContents
Range("A1:A2").Select
With Selection
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlCenter
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Selection.UnMerge
Selection.Merge
Range("C1:F1").Select
With Selection
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlCenter
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Selection.UnMerge
Selection.UnMerge
Range("C1:C2").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Selection.Merge
Range("D1:D2").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Selection.Merge
Range("E1:E2").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Selection.Merge
Range("F1:F2").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Selection.Merge
Range("G1:G2").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Selection.Merge
Range("J1:M1").Select
With Selection
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlCenter
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Selection.UnMerge
ActiveWindow.SmallScroll ToRight:=6
Range("J1:J2").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Selection.Merge
Range("K1:K2").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Selection.Merge
Range("L1:L2").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Selection.Merge
Range("M1:M2").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Selection.Merge
Cells.Select
Selection.AutoFilter
Range("A4").Select
ActiveSheet.Range("$A$1:$O$146").AutoFilter Field:=1, Criteria1:="="
Rows("5:5").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.SpecialCells(xlCellTypeVisible).Select
Selection.Delete Shift:=xlUp
ActiveSheet.Range("$A$1:$O$96").AutoFilter Field:=1
ActiveSheet.Range("$A$1:$O$96").AutoFilter Field:=8, Criteria1:=Array("18", _
"5", "="), Operator:=xlFilterValues
Rows("3:3").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.SpecialCells(xlCellTypeVisible).Select
Union(Range( _
"67:67,69:69,71:71,73:73,75:75,77:77,79:79,81:81,83:83,85:85,87:87,89:89,91:91,93:93,95:95,3:3,5:5,7:7,9:9,11:11,13:13,15:15,17:17,19:19,21:21,23:23,25:25,27:27,29:29,31:31,33:33,35:35" _
), Range( _
"37:37,39:39,41:41,43:43,45:45,47:47,49:49,51:51,53:53,55:55,57:57,59:59,61:61,63:63,65:65" _
)).Select
Selection.Delete Shift:=xlUp
ActiveSheet.Range("$A$1:$O$49").AutoFilter Field:=8
Columns("B:B").ColumnWidth = 19.91
Columns("B:B").EntireColumn.AutoFit
Columns("D:D").Select
Selection.Replace What:="-Total", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Range("a1").Select
Application.ScreenUpdating = True
End Sub
then press F5 then press ALT +q
 |
| You get your file ready |
FOR SAFETY: Apply it on duplicate ,not in original.
We are not responsible for any data loss .
High Technologies Solutions has conducted multiple Advanced Excel Corporate Training, VBA Macros Corporate Training batches in all over India. Further More Details Here-+91-9311002620 Or Visit Website- https://www.htsindia.com/Courses/Business-Analytics/adv-excel-training-course
ReplyDelete