Home Menu

Menu


ExcelBanter » Excel Newsgroups » Excel Programming > Condense code
Reply
 
LinkBack Thread Tools Search this Thread Display Modes
  #1   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 386
Default 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
Reply With QuoteReply With Quote
  #2   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 1,298
Default 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
Reply With QuoteReply With Quote
  #3   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 386
Default 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
Reply With QuoteReply With Quote
Reply
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes
Linear Mode Linear Mode

Posting Rules
Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On

Similar Threads
Thread Thread Starter Forum Replies Last Post
Condense a formula gotroots Excel Worksheet Functions 1 December 16th 09 03:25 PM
Multiple Sendkeys not working... need help to condense code Mr. m0le[_2_] Excel Programming 10 June 8th 09 11:55 PM
condense code for gridelines SITCFanTN New Users to Excel 1 June 30th 06 02:31 PM
Condense Code Nigel Excel Programming 2 December 22nd 05 11:59 PM
Help to condense a formula GerryK Excel Worksheet Functions 1 June 29th 05 08:19 PM


All times are GMT +1. The time now is 01:33 PM.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
Copyright ©2004-2024 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"

 

Contact Us ExcelBanter forum home Privacy Statement