ExcelBanter

ExcelBanter (https://www.excelbanter.com/)
-   Excel Programming (https://www.excelbanter.com/excel-programming/)
-   -   Condense code (https://www.excelbanter.com/excel-programming/433239-condense-code.html)

LiAD
Condense code
 
Hi,

Is there a neater/easier way of writing this code? Its quite long and
doesnt do very much but I cant see a way of looping or stepping through it to
condense it.

Thanks
LiAD

Sub SeparateTMs()

Rows("2:2").Select
Selection.AutoFilter
Selection.AutoFilter Field:=3, Criteria1:="TM197"
Range("B3:AB800").Select
Application.CutCopyMode = False
Selection.Copy
Range("AK3").Select
Selection.PasteSpecial Paste:=xlPasteAllExceptBorders,
Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Selection.AutoFilter

Columns("AL").Select
Selection.delete

Range("AK1:BJ1").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Selection.Merge

Rows("2:2").Select
Selection.AutoFilter
Selection.AutoFilter Field:=3, Criteria1:="TM199"
Range("B3:AB800").Select
Application.CutCopyMode = False
Selection.Copy
Range("BN3").Select
Selection.PasteSpecial Paste:=xlPasteAllExceptBorders,
Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Selection.AutoFilter

Columns("BP").Select
Selection.delete

Range("BN1:CN1").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Selection.Merge

Rows("2:2").Select
Selection.AutoFilter
Selection.AutoFilter Field:=3, Criteria1:="TM206"
Range("B3:AB800").Select
Application.CutCopyMode = False
Selection.Copy
Range("CV3").Select
Selection.PasteSpecial Paste:=xlPasteAllExceptBorders,
Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Selection.AutoFilter

Columns("CW").Select
Selection.delete

Range("CV1:DV1").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Selection.Merge

Range("AK1").Select

End Sub

Patrick Molloy[_2_]
Condense code
 
for one, you have three of these
Range("AK1:BJ1").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With

so you can replace with one block

With Range("AK1:BJ1,BN1:CN1,CV1:DV1")
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With



"LiAD" wrote:

Hi,

Is there a neater/easier way of writing this code? Its quite long and
doesnt do very much but I cant see a way of looping or stepping through it to
condense it.

Thanks
LiAD

Sub SeparateTMs()

Rows("2:2").Select
Selection.AutoFilter
Selection.AutoFilter Field:=3, Criteria1:="TM197"
Range("B3:AB800").Select
Application.CutCopyMode = False
Selection.Copy
Range("AK3").Select
Selection.PasteSpecial Paste:=xlPasteAllExceptBorders,
Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Selection.AutoFilter

Columns("AL").Select
Selection.delete

Range("AK1:BJ1").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Selection.Merge

Rows("2:2").Select
Selection.AutoFilter
Selection.AutoFilter Field:=3, Criteria1:="TM199"
Range("B3:AB800").Select
Application.CutCopyMode = False
Selection.Copy
Range("BN3").Select
Selection.PasteSpecial Paste:=xlPasteAllExceptBorders,
Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Selection.AutoFilter

Columns("BP").Select
Selection.delete

Range("BN1:CN1").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Selection.Merge

Rows("2:2").Select
Selection.AutoFilter
Selection.AutoFilter Field:=3, Criteria1:="TM206"
Range("B3:AB800").Select
Application.CutCopyMode = False
Selection.Copy
Range("CV3").Select
Selection.PasteSpecial Paste:=xlPasteAllExceptBorders,
Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Selection.AutoFilter

Columns("CW").Select
Selection.delete

Range("CV1:DV1").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Selection.Merge

Range("AK1").Select

End Sub

LiAD
Condense code
 
True

Thanks

"Patrick Molloy" wrote:

for one, you have three of these
Range("AK1:BJ1").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With

so you can replace with one block

With Range("AK1:BJ1,BN1:CN1,CV1:DV1")
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With



"LiAD" wrote:

Hi,

Is there a neater/easier way of writing this code? Its quite long and
doesnt do very much but I cant see a way of looping or stepping through it to
condense it.

Thanks
LiAD

Sub SeparateTMs()

Rows("2:2").Select
Selection.AutoFilter
Selection.AutoFilter Field:=3, Criteria1:="TM197"
Range("B3:AB800").Select
Application.CutCopyMode = False
Selection.Copy
Range("AK3").Select
Selection.PasteSpecial Paste:=xlPasteAllExceptBorders,
Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Selection.AutoFilter

Columns("AL").Select
Selection.delete

Range("AK1:BJ1").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Selection.Merge

Rows("2:2").Select
Selection.AutoFilter
Selection.AutoFilter Field:=3, Criteria1:="TM199"
Range("B3:AB800").Select
Application.CutCopyMode = False
Selection.Copy
Range("BN3").Select
Selection.PasteSpecial Paste:=xlPasteAllExceptBorders,
Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Selection.AutoFilter

Columns("BP").Select
Selection.delete

Range("BN1:CN1").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Selection.Merge

Rows("2:2").Select
Selection.AutoFilter
Selection.AutoFilter Field:=3, Criteria1:="TM206"
Range("B3:AB800").Select
Application.CutCopyMode = False
Selection.Copy
Range("CV3").Select
Selection.PasteSpecial Paste:=xlPasteAllExceptBorders,
Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Selection.AutoFilter

Columns("CW").Select
Selection.delete

Range("CV1:DV1").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Selection.Merge

Range("AK1").Select

End Sub


All times are GMT +1. The time now is 09:49 AM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
ExcelBanter.com