Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.misc
|
|||
|
|||
Shorten a Macro
Hi All ---- Seasons Greetings
Below is a macro I recorded it goes on for 23 Sheets --- I'm only showing the 1st three sheets in the macro--- is there a way of cutting down on all the code that is needed to run the full macro. Sheets("RPRA").Select Columns("E:E").Select Selection.TextToColumns Destination:=Range("G1"), DataType:=xlDelimited, _ TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=False, _ Semicolon:=False, Comma:=True, Space:=False, Other:=True, FieldInfo:= _ Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1)), TrailingMinusNumbers:= _ True Range("I316:J323").Select Selection.Copy Sheets("OLD GLOSSOP").Select Range("Z2").Select ActiveSheet.Paste With Selection.Interior .ColorIndex = 40 .Pattern = xlSolid End With Selection.Borders(xlDiagonalDown).LineStyle = xlNone Selection.Borders(xlDiagonalUp).LineStyle = xlNone With Selection.Borders(xlEdgeLeft) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With Selection.Borders(xlEdgeTop) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With Selection.Borders(xlEdgeBottom) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With Selection.Borders(xlEdgeRight) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With Selection.Borders(xlInsideVertical) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With Selection.Borders(xlInsideHorizontal) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With Selection.Font .Name = "Times New Roman" .Size = 10 .Strikethrough = False .Superscript = False .Subscript = False .OutlineFont = False .Shadow = False .Underline = xlUnderlineStyleNone .ColorIndex = xlAutomatic End With Selection.Font.Bold = True With Selection .HorizontalAlignment = xlCenter .VerticalAlignment = xlBottom .WrapText = False .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = False End With Sheets("RPRA").Select Range("I324:J338").Select Selection.Copy Sheets("PACKMOOR").Select Range("Z2").Select ActiveSheet.Paste With Selection.Interior .ColorIndex = 40 .Pattern = xlSolid End With Selection.Borders(xlDiagonalDown).LineStyle = xlNone Selection.Borders(xlDiagonalUp).LineStyle = xlNone With Selection.Borders(xlEdgeLeft) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With Selection.Borders(xlEdgeTop) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With Selection.Borders(xlEdgeBottom) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With Selection.Borders(xlEdgeRight) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With Selection.Borders(xlInsideVertical) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With Selection.Borders(xlInsideHorizontal) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With Selection.Font .Name = "Times New Roman" .Size = 10 .Strikethrough = False .Superscript = False .Subscript = False .OutlineFont = False .Shadow = False .Underline = xlUnderlineStyleNone .ColorIndex = xlAutomatic End With Selection.Font.Bold = True With Selection .HorizontalAlignment = xlCenter .VerticalAlignment = xlBottom .WrapText = False .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = False End With Sheets("RPRA").Select Range("I2:J19").Select Selection.Copy Sheets("ALTON").Select Range("Z2").Select ActiveSheet.Paste With Selection.Interior .ColorIndex = 40 .Pattern = xlSolid End With Selection.Borders(xlDiagonalDown).LineStyle = xlNone Selection.Borders(xlDiagonalUp).LineStyle = xlNone With Selection.Borders(xlEdgeLeft) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With Selection.Borders(xlEdgeTop) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With Selection.Borders(xlEdgeBottom) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With Selection.Borders(xlEdgeRight) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With Selection.Borders(xlInsideVertical) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With Selection.Borders(xlInsideHorizontal) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With Selection.Font .Name = "Times New Roman" .Size = 10 .Strikethrough = False .Superscript = False .Subscript = False .OutlineFont = False .Shadow = False .Underline = xlUnderlineStyleNone .ColorIndex = xlAutomatic End With Selection.Font.Bold = True With Selection .HorizontalAlignment = xlCenter .VerticalAlignment = xlBottom .WrapText = False .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = False End With End Sub Any Help Appreciated Cheers Mully |
#2
Posted to microsoft.public.excel.misc
|
|||
|
|||
Shorten a Macro
am no expert but something like
Sheets("RPRA").Select Columns("E:E").Select For n = 1 To Sheets.Count Sheets(n).Range("Z2").Select ActiveSheet.Paste Next n but this will only work if copying the same info into everypage "mully" wrote: Hi All ---- Seasons Greetings Below is a macro I recorded it goes on for 23 Sheets --- I'm only showing the 1st three sheets in the macro--- is there a way of cutting down on all the code that is needed to run the full macro. Sheets("RPRA").Select Columns("E:E").Select Selection.TextToColumns Destination:=Range("G1"), DataType:=xlDelimited, _ TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=False, _ Semicolon:=False, Comma:=True, Space:=False, Other:=True, FieldInfo:= _ Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1)), TrailingMinusNumbers:= _ True Range("I316:J323").Select Selection.Copy Sheets("OLD GLOSSOP").Select Range("Z2").Select ActiveSheet.Paste With Selection.Interior .ColorIndex = 40 .Pattern = xlSolid End With Selection.Borders(xlDiagonalDown).LineStyle = xlNone Selection.Borders(xlDiagonalUp).LineStyle = xlNone With Selection.Borders(xlEdgeLeft) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With Selection.Borders(xlEdgeTop) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With Selection.Borders(xlEdgeBottom) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With Selection.Borders(xlEdgeRight) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With Selection.Borders(xlInsideVertical) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With Selection.Borders(xlInsideHorizontal) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With Selection.Font .Name = "Times New Roman" .Size = 10 .Strikethrough = False .Superscript = False .Subscript = False .OutlineFont = False .Shadow = False .Underline = xlUnderlineStyleNone .ColorIndex = xlAutomatic End With Selection.Font.Bold = True With Selection .HorizontalAlignment = xlCenter .VerticalAlignment = xlBottom .WrapText = False .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = False End With Sheets("RPRA").Select Range("I324:J338").Select Selection.Copy Sheets("PACKMOOR").Select Range("Z2").Select ActiveSheet.Paste With Selection.Interior .ColorIndex = 40 .Pattern = xlSolid End With Selection.Borders(xlDiagonalDown).LineStyle = xlNone Selection.Borders(xlDiagonalUp).LineStyle = xlNone With Selection.Borders(xlEdgeLeft) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With Selection.Borders(xlEdgeTop) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With Selection.Borders(xlEdgeBottom) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With Selection.Borders(xlEdgeRight) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With Selection.Borders(xlInsideVertical) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With Selection.Borders(xlInsideHorizontal) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With Selection.Font .Name = "Times New Roman" .Size = 10 .Strikethrough = False .Superscript = False .Subscript = False .OutlineFont = False .Shadow = False .Underline = xlUnderlineStyleNone .ColorIndex = xlAutomatic End With Selection.Font.Bold = True With Selection .HorizontalAlignment = xlCenter .VerticalAlignment = xlBottom .WrapText = False .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = False End With Sheets("RPRA").Select Range("I2:J19").Select Selection.Copy Sheets("ALTON").Select Range("Z2").Select ActiveSheet.Paste With Selection.Interior .ColorIndex = 40 .Pattern = xlSolid End With Selection.Borders(xlDiagonalDown).LineStyle = xlNone Selection.Borders(xlDiagonalUp).LineStyle = xlNone With Selection.Borders(xlEdgeLeft) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With Selection.Borders(xlEdgeTop) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With Selection.Borders(xlEdgeBottom) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With Selection.Borders(xlEdgeRight) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With Selection.Borders(xlInsideVertical) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With Selection.Borders(xlInsideHorizontal) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With Selection.Font .Name = "Times New Roman" .Size = 10 .Strikethrough = False .Superscript = False .Subscript = False .OutlineFont = False .Shadow = False .Underline = xlUnderlineStyleNone .ColorIndex = xlAutomatic End With Selection.Font.Bold = True With Selection .HorizontalAlignment = xlCenter .VerticalAlignment = xlBottom .WrapText = False .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = False End With End Sub Any Help Appreciated Cheers Mully |
#3
Posted to microsoft.public.excel.misc
|
|||
|
|||
Shorten a Macro
Since most of the code involves formatting - or perhaps it'd be more accurate
to call it RE-FORMATTING - the cells that you are pasting into, one quick way to simplify the code would be to avoid pasting. You could do a Paste Special - Values instead. So.. this code: Range("I316:J323").Copy Sheets("OLD GLOSSOP").Range("Z2")..PasteSpecial xlPasteValues would replace all of this: Range("I316:J323").Select Selection.Copy Sheets("OLD GLOSSOP").Select Range("Z2").Select ActiveSheet.Paste With Selection.Interior .ColorIndex = 40 .Pattern = xlSolid End With Selection.Borders(xlDiagonalDown).LineStyle = xlNone Selection.Borders(xlDiagonalUp).LineStyle = xlNone With Selection.Borders(xlEdgeLeft) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With Selection.Borders(xlEdgeTop) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With Selection.Borders(xlEdgeBottom) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With Selection.Borders(xlEdgeRight) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With Selection.Borders(xlInsideVertical) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With Selection.Borders(xlInsideHorizontal) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With Selection.Font .Name = "Times New Roman" .Size = 10 .Strikethrough = False .Superscript = False .Subscript = False .OutlineFont = False .Shadow = False .Underline = xlUnderlineStyleNone .ColorIndex = xlAutomatic End With Selection.Font.Bold = True With Selection .HorizontalAlignment = xlCenter .VerticalAlignment = xlBottom .WrapText = False .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = False End With "mully" wrote: Hi All ---- Seasons Greetings Below is a macro I recorded it goes on for 23 Sheets --- I'm only showing the 1st three sheets in the macro--- is there a way of cutting down on all the code that is needed to run the full macro. Sheets("RPRA").Select Columns("E:E").Select Selection.TextToColumns Destination:=Range("G1"), DataType:=xlDelimited, _ TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=False, _ Semicolon:=False, Comma:=True, Space:=False, Other:=True, FieldInfo:= _ Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1)), TrailingMinusNumbers:= _ True Range("I316:J323").Select Selection.Copy Sheets("OLD GLOSSOP").Select Range("Z2").Select ActiveSheet.Paste With Selection.Interior .ColorIndex = 40 .Pattern = xlSolid End With Selection.Borders(xlDiagonalDown).LineStyle = xlNone Selection.Borders(xlDiagonalUp).LineStyle = xlNone With Selection.Borders(xlEdgeLeft) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With Selection.Borders(xlEdgeTop) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With Selection.Borders(xlEdgeBottom) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With Selection.Borders(xlEdgeRight) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With Selection.Borders(xlInsideVertical) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With Selection.Borders(xlInsideHorizontal) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With Selection.Font .Name = "Times New Roman" .Size = 10 .Strikethrough = False .Superscript = False .Subscript = False .OutlineFont = False .Shadow = False .Underline = xlUnderlineStyleNone .ColorIndex = xlAutomatic End With Selection.Font.Bold = True With Selection .HorizontalAlignment = xlCenter .VerticalAlignment = xlBottom .WrapText = False .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = False End With Sheets("RPRA").Select Range("I324:J338").Select Selection.Copy Sheets("PACKMOOR").Select Range("Z2").Select ActiveSheet.Paste With Selection.Interior .ColorIndex = 40 .Pattern = xlSolid End With Selection.Borders(xlDiagonalDown).LineStyle = xlNone Selection.Borders(xlDiagonalUp).LineStyle = xlNone With Selection.Borders(xlEdgeLeft) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With Selection.Borders(xlEdgeTop) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With Selection.Borders(xlEdgeBottom) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With Selection.Borders(xlEdgeRight) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With Selection.Borders(xlInsideVertical) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With Selection.Borders(xlInsideHorizontal) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With Selection.Font .Name = "Times New Roman" .Size = 10 .Strikethrough = False .Superscript = False .Subscript = False .OutlineFont = False .Shadow = False .Underline = xlUnderlineStyleNone .ColorIndex = xlAutomatic End With Selection.Font.Bold = True With Selection .HorizontalAlignment = xlCenter .VerticalAlignment = xlBottom .WrapText = False .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = False End With Sheets("RPRA").Select Range("I2:J19").Select Selection.Copy Sheets("ALTON").Select Range("Z2").Select ActiveSheet.Paste With Selection.Interior .ColorIndex = 40 .Pattern = xlSolid End With Selection.Borders(xlDiagonalDown).LineStyle = xlNone Selection.Borders(xlDiagonalUp).LineStyle = xlNone With Selection.Borders(xlEdgeLeft) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With Selection.Borders(xlEdgeTop) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With Selection.Borders(xlEdgeBottom) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With Selection.Borders(xlEdgeRight) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With Selection.Borders(xlInsideVertical) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With Selection.Borders(xlInsideHorizontal) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With Selection.Font .Name = "Times New Roman" .Size = 10 .Strikethrough = False .Superscript = False .Subscript = False .OutlineFont = False .Shadow = False .Underline = xlUnderlineStyleNone .ColorIndex = xlAutomatic End With Selection.Font.Bold = True With Selection .HorizontalAlignment = xlCenter .VerticalAlignment = xlBottom .WrapText = False .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = False End With End Sub Any Help Appreciated Cheers Mully |
#4
Posted to microsoft.public.excel.misc
|
|||
|
|||
Shorten a Macro
Split the common stuff into a separate procedure, remove all the default
settings etc. For example Sheets("RPRA").Select Columns("E:E").TextToColumns Destination:=Range("G1"), _ DataType:=xlDelimited, _ TextQualifier:=xlDoubleQuote, _ ConsecutiveDelimiter:=True, _ Tab:=False, Semicolon:=False, Comma:=True, _ Space:=False, Other:=True, _ FieldInfo:=Array(Array(1, 1), Array(2, 1), _ Array(3, 1), Array(4, 1)), _ TrailingMinusNumbers:=True FormatSheet Range("I316:J323"), Sheets("OLD GLOSSOP").Range("Z2") FormatSheet Range("I324:J338"), Sheets("PACKMOOR").Range("Z2") FormatSheet Range("I2:J19"), Sheets("ALTON").Range("Z2") End Sub Sub FormatSheet(Source As Range, Target As Range) Sheets("RPRA").Source.Copy Target With Target .Interior .ColorIndex = 40 .Pattern = xlSolid With .Borders(xlEdgeLeft) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With .Borders(xlEdgeTop) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With .Borders(xlEdgeBottom) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With .Borders(xlEdgeRight) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With .Borders(xlInsideVertical) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With .Borders(xlInsideHorizontal) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With .Font .Name = "Times New Roman" .Size = 10 .Font.Bold = True End With .HorizontalAlignment = xlCenter .VerticalAlignment = xlBottom End With End Sub -- HTH RP (remove nothere from the email address if mailing direct) "mully" wrote in message ... Hi All ---- Seasons Greetings Below is a macro I recorded it goes on for 23 Sheets --- I'm only showing the 1st three sheets in the macro--- is there a way of cutting down on all the code that is needed to run the full macro. Sheets("RPRA").Select Columns("E:E").Select Selection.TextToColumns Destination:=Range("G1"), DataType:=xlDelimited, _ TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=False, _ Semicolon:=False, Comma:=True, Space:=False, Other:=True, FieldInfo:= _ Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1)), TrailingMinusNumbers:= _ True Range("I316:J323").Select Selection.Copy Sheets("OLD GLOSSOP").Select Range("Z2").Select ActiveSheet.Paste With Selection.Interior .ColorIndex = 40 .Pattern = xlSolid End With Selection.Borders(xlDiagonalDown).LineStyle = xlNone Selection.Borders(xlDiagonalUp).LineStyle = xlNone With Selection.Borders(xlEdgeLeft) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With Selection.Borders(xlEdgeTop) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With Selection.Borders(xlEdgeBottom) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With Selection.Borders(xlEdgeRight) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With Selection.Borders(xlInsideVertical) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With Selection.Borders(xlInsideHorizontal) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With Selection.Font .Name = "Times New Roman" .Size = 10 .Strikethrough = False .Superscript = False .Subscript = False .OutlineFont = False .Shadow = False .Underline = xlUnderlineStyleNone .ColorIndex = xlAutomatic End With Selection.Font.Bold = True With Selection .HorizontalAlignment = xlCenter .VerticalAlignment = xlBottom .WrapText = False .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = False End With Sheets("RPRA").Select Range("I324:J338").Select Selection.Copy Sheets("PACKMOOR").Select Range("Z2").Select ActiveSheet.Paste With Selection.Interior .ColorIndex = 40 .Pattern = xlSolid End With Selection.Borders(xlDiagonalDown).LineStyle = xlNone Selection.Borders(xlDiagonalUp).LineStyle = xlNone With Selection.Borders(xlEdgeLeft) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With Selection.Borders(xlEdgeTop) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With Selection.Borders(xlEdgeBottom) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With Selection.Borders(xlEdgeRight) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With Selection.Borders(xlInsideVertical) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With Selection.Borders(xlInsideHorizontal) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With Selection.Font .Name = "Times New Roman" .Size = 10 .Strikethrough = False .Superscript = False .Subscript = False .OutlineFont = False .Shadow = False .Underline = xlUnderlineStyleNone .ColorIndex = xlAutomatic End With Selection.Font.Bold = True With Selection .HorizontalAlignment = xlCenter .VerticalAlignment = xlBottom .WrapText = False .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = False End With Sheets("RPRA").Select Range("I2:J19").Select Selection.Copy Sheets("ALTON").Select Range("Z2").Select ActiveSheet.Paste With Selection.Interior .ColorIndex = 40 .Pattern = xlSolid End With Selection.Borders(xlDiagonalDown).LineStyle = xlNone Selection.Borders(xlDiagonalUp).LineStyle = xlNone With Selection.Borders(xlEdgeLeft) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With Selection.Borders(xlEdgeTop) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With Selection.Borders(xlEdgeBottom) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With Selection.Borders(xlEdgeRight) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With Selection.Borders(xlInsideVertical) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With Selection.Borders(xlInsideHorizontal) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With Selection.Font .Name = "Times New Roman" .Size = 10 .Strikethrough = False .Superscript = False .Subscript = False .OutlineFont = False .Shadow = False .Underline = xlUnderlineStyleNone .ColorIndex = xlAutomatic End With Selection.Font.Bold = True With Selection .HorizontalAlignment = xlCenter .VerticalAlignment = xlBottom .WrapText = False .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = False End With End Sub Any Help Appreciated Cheers Mully |
#5
Posted to microsoft.public.excel.misc
|
|||
|
|||
Shorten a Macro
Hi Gentlemen
Thanks for all the info managed to get Managed to get both Duke & Bobs' working OK as there is different info Rich wasn't feasible --- just one query the info at the moment is entering columns & cells Z2/AA2 range for "ALTON" The question is if I had more info for "ALTON" it would have to go into columns AB/AC is it possible for the macro to search and find the first empty columns which would be AB/AC then do the business of entering the data which would always be in sheet "(RPRA") range "I2:J19) Once again Thanks --- Have a Happy & Prosperous 2006 Cheers Mully "Bob Phillips" wrote: Split the common stuff into a separate procedure, remove all the default settings etc. For example Sheets("RPRA").Select Columns("E:E").TextToColumns Destination:=Range("G1"), _ DataType:=xlDelimited, _ TextQualifier:=xlDoubleQuote, _ ConsecutiveDelimiter:=True, _ Tab:=False, Semicolon:=False, Comma:=True, _ Space:=False, Other:=True, _ FieldInfo:=Array(Array(1, 1), Array(2, 1), _ Array(3, 1), Array(4, 1)), _ TrailingMinusNumbers:=True FormatSheet Range("I316:J323"), Sheets("OLD GLOSSOP").Range("Z2") FormatSheet Range("I324:J338"), Sheets("PACKMOOR").Range("Z2") FormatSheet Range("I2:J19"), Sheets("ALTON").Range("Z2") End Sub Sub FormatSheet(Source As Range, Target As Range) Sheets("RPRA").Source.Copy Target With Target .Interior .ColorIndex = 40 .Pattern = xlSolid With .Borders(xlEdgeLeft) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With .Borders(xlEdgeTop) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With .Borders(xlEdgeBottom) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With .Borders(xlEdgeRight) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With .Borders(xlInsideVertical) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With .Borders(xlInsideHorizontal) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With .Font .Name = "Times New Roman" .Size = 10 .Font.Bold = True End With .HorizontalAlignment = xlCenter .VerticalAlignment = xlBottom End With End Sub -- HTH RP (remove nothere from the email address if mailing direct) "mully" wrote in message ... Hi All ---- Seasons Greetings Below is a macro I recorded it goes on for 23 Sheets --- I'm only showing the 1st three sheets in the macro--- is there a way of cutting down on all the code that is needed to run the full macro. Sheets("RPRA").Select Columns("E:E").Select Selection.TextToColumns Destination:=Range("G1"), DataType:=xlDelimited, _ TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=False, _ Semicolon:=False, Comma:=True, Space:=False, Other:=True, FieldInfo:= _ Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1)), TrailingMinusNumbers:= _ True Range("I316:J323").Select Selection.Copy Sheets("OLD GLOSSOP").Select Range("Z2").Select ActiveSheet.Paste With Selection.Interior .ColorIndex = 40 .Pattern = xlSolid End With Selection.Borders(xlDiagonalDown).LineStyle = xlNone Selection.Borders(xlDiagonalUp).LineStyle = xlNone With Selection.Borders(xlEdgeLeft) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With Selection.Borders(xlEdgeTop) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With Selection.Borders(xlEdgeBottom) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With Selection.Borders(xlEdgeRight) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With Selection.Borders(xlInsideVertical) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With Selection.Borders(xlInsideHorizontal) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With Selection.Font .Name = "Times New Roman" .Size = 10 .Strikethrough = False .Superscript = False .Subscript = False .OutlineFont = False .Shadow = False .Underline = xlUnderlineStyleNone .ColorIndex = xlAutomatic End With Selection.Font.Bold = True With Selection .HorizontalAlignment = xlCenter .VerticalAlignment = xlBottom .WrapText = False .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = False End With Sheets("RPRA").Select Range("I324:J338").Select Selection.Copy Sheets("PACKMOOR").Select Range("Z2").Select ActiveSheet.Paste With Selection.Interior .ColorIndex = 40 .Pattern = xlSolid End With Selection.Borders(xlDiagonalDown).LineStyle = xlNone Selection.Borders(xlDiagonalUp).LineStyle = xlNone With Selection.Borders(xlEdgeLeft) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With Selection.Borders(xlEdgeTop) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With Selection.Borders(xlEdgeBottom) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With Selection.Borders(xlEdgeRight) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With Selection.Borders(xlInsideVertical) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With Selection.Borders(xlInsideHorizontal) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With Selection.Font .Name = "Times New Roman" .Size = 10 .Strikethrough = False .Superscript = False .Subscript = False .OutlineFont = False .Shadow = False .Underline = xlUnderlineStyleNone .ColorIndex = xlAutomatic End With Selection.Font.Bold = True With Selection .HorizontalAlignment = xlCenter .VerticalAlignment = xlBottom .WrapText = False .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = False End With Sheets("RPRA").Select Range("I2:J19").Select Selection.Copy Sheets("ALTON").Select Range("Z2").Select ActiveSheet.Paste With Selection.Interior .ColorIndex = 40 .Pattern = xlSolid End With Selection.Borders(xlDiagonalDown).LineStyle = xlNone Selection.Borders(xlDiagonalUp).LineStyle = xlNone With Selection.Borders(xlEdgeLeft) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With Selection.Borders(xlEdgeTop) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With Selection.Borders(xlEdgeBottom) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With Selection.Borders(xlEdgeRight) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With Selection.Borders(xlInsideVertical) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With Selection.Borders(xlInsideHorizontal) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With Selection.Font .Name = "Times New Roman" .Size = 10 .Strikethrough = False .Superscript = False .Subscript = False .OutlineFont = False .Shadow = False .Underline = xlUnderlineStyleNone .ColorIndex = xlAutomatic End With Selection.Font.Bold = True With Selection .HorizontalAlignment = xlCenter .VerticalAlignment = xlBottom .WrapText = False .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = False End With End Sub Any Help Appreciated |
#6
Posted to microsoft.public.excel.misc
|
|||
|
|||
Shorten a Macro
You can fine the first empty column number with
iLastCol = Cells(2,Columns.Count).End(xlToLeft).Column and use this like so (in my version) FormatSheet Range("I2:J19"), Sheets("ALTON") End Sub Sub FormatSheet(Source As Range, Target As Worksheet) Dim iLastCol As Long iLastCol = Cells(2,Columns.Count).End(xlToLeft).Column Sheets("RPRA").Source.Copy Target.Cells(2,iLastCol) With Target -- HTH RP (remove nothere from the email address if mailing direct) "mully" wrote in message ... Hi Gentlemen Thanks for all the info managed to get Managed to get both Duke & Bobs' working OK as there is different info Rich wasn't feasible --- just one query the info at the moment is entering columns & cells Z2/AA2 range for "ALTON" The question is if I had more info for "ALTON" it would have to go into columns AB/AC is it possible for the macro to search and find the first empty columns which would be AB/AC then do the business of entering the data which would always be in sheet "(RPRA") range "I2:J19) Once again Thanks --- Have a Happy & Prosperous 2006 Cheers Mully "Bob Phillips" wrote: Split the common stuff into a separate procedure, remove all the default settings etc. For example Sheets("RPRA").Select Columns("E:E").TextToColumns Destination:=Range("G1"), _ DataType:=xlDelimited, _ TextQualifier:=xlDoubleQuote, _ ConsecutiveDelimiter:=True, _ Tab:=False, Semicolon:=False, Comma:=True, _ Space:=False, Other:=True, _ FieldInfo:=Array(Array(1, 1), Array(2, 1), _ Array(3, 1), Array(4, 1)), _ TrailingMinusNumbers:=True FormatSheet Range("I316:J323"), Sheets("OLD GLOSSOP").Range("Z2") FormatSheet Range("I324:J338"), Sheets("PACKMOOR").Range("Z2") FormatSheet Range("I2:J19"), Sheets("ALTON").Range("Z2") End Sub Sub FormatSheet(Source As Range, Target As Range) Sheets("RPRA").Source.Copy Target With Target .Interior .ColorIndex = 40 .Pattern = xlSolid With .Borders(xlEdgeLeft) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With .Borders(xlEdgeTop) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With .Borders(xlEdgeBottom) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With .Borders(xlEdgeRight) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With .Borders(xlInsideVertical) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With .Borders(xlInsideHorizontal) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With .Font .Name = "Times New Roman" .Size = 10 .Font.Bold = True End With .HorizontalAlignment = xlCenter .VerticalAlignment = xlBottom End With End Sub -- HTH RP (remove nothere from the email address if mailing direct) "mully" wrote in message ... Hi All ---- Seasons Greetings Below is a macro I recorded it goes on for 23 Sheets --- I'm only showing the 1st three sheets in the macro--- is there a way of cutting down on all the code that is needed to run the full macro. Sheets("RPRA").Select Columns("E:E").Select Selection.TextToColumns Destination:=Range("G1"), DataType:=xlDelimited, _ TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=False, _ Semicolon:=False, Comma:=True, Space:=False, Other:=True, FieldInfo:= _ Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1)), TrailingMinusNumbers:= _ True Range("I316:J323").Select Selection.Copy Sheets("OLD GLOSSOP").Select Range("Z2").Select ActiveSheet.Paste With Selection.Interior .ColorIndex = 40 .Pattern = xlSolid End With Selection.Borders(xlDiagonalDown).LineStyle = xlNone Selection.Borders(xlDiagonalUp).LineStyle = xlNone With Selection.Borders(xlEdgeLeft) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With Selection.Borders(xlEdgeTop) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With Selection.Borders(xlEdgeBottom) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With Selection.Borders(xlEdgeRight) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With Selection.Borders(xlInsideVertical) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With Selection.Borders(xlInsideHorizontal) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With Selection.Font .Name = "Times New Roman" .Size = 10 .Strikethrough = False .Superscript = False .Subscript = False .OutlineFont = False .Shadow = False .Underline = xlUnderlineStyleNone .ColorIndex = xlAutomatic End With Selection.Font.Bold = True With Selection .HorizontalAlignment = xlCenter .VerticalAlignment = xlBottom .WrapText = False .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = False End With Sheets("RPRA").Select Range("I324:J338").Select Selection.Copy Sheets("PACKMOOR").Select Range("Z2").Select ActiveSheet.Paste With Selection.Interior .ColorIndex = 40 .Pattern = xlSolid End With Selection.Borders(xlDiagonalDown).LineStyle = xlNone Selection.Borders(xlDiagonalUp).LineStyle = xlNone With Selection.Borders(xlEdgeLeft) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With Selection.Borders(xlEdgeTop) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With Selection.Borders(xlEdgeBottom) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With Selection.Borders(xlEdgeRight) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With Selection.Borders(xlInsideVertical) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With Selection.Borders(xlInsideHorizontal) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With Selection.Font .Name = "Times New Roman" .Size = 10 .Strikethrough = False .Superscript = False .Subscript = False .OutlineFont = False .Shadow = False .Underline = xlUnderlineStyleNone .ColorIndex = xlAutomatic End With Selection.Font.Bold = True With Selection .HorizontalAlignment = xlCenter .VerticalAlignment = xlBottom .WrapText = False .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = False End With Sheets("RPRA").Select Range("I2:J19").Select Selection.Copy Sheets("ALTON").Select Range("Z2").Select ActiveSheet.Paste With Selection.Interior .ColorIndex = 40 .Pattern = xlSolid End With Selection.Borders(xlDiagonalDown).LineStyle = xlNone Selection.Borders(xlDiagonalUp).LineStyle = xlNone With Selection.Borders(xlEdgeLeft) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With Selection.Borders(xlEdgeTop) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With Selection.Borders(xlEdgeBottom) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With Selection.Borders(xlEdgeRight) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With Selection.Borders(xlInsideVertical) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With Selection.Borders(xlInsideHorizontal) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With Selection.Font .Name = "Times New Roman" .Size = 10 .Strikethrough = False .Superscript = False .Subscript = False .OutlineFont = False .Shadow = False .Underline = xlUnderlineStyleNone .ColorIndex = xlAutomatic End With Selection.Font.Bold = True With Selection .HorizontalAlignment = xlCenter .VerticalAlignment = xlBottom .WrapText = False .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = False End With End Sub Any Help Appreciated |
#7
Posted to microsoft.public.excel.misc
|
|||
|
|||
Shorten a Macro
Hi Bob
Thanks for info will have a go tomorrow -- got visitors arriving shortly --- will either of catch Chelsea??? Cheers Mully "Bob Phillips" wrote: You can fine the first empty column number with iLastCol = Cells(2,Columns.Count).End(xlToLeft).Column and use this like so (in my version) FormatSheet Range("I2:J19"), Sheets("ALTON") End Sub Sub FormatSheet(Source As Range, Target As Worksheet) Dim iLastCol As Long iLastCol = Cells(2,Columns.Count).End(xlToLeft).Column Sheets("RPRA").Source.Copy Target.Cells(2,iLastCol) With Target -- HTH RP (remove nothere from the email address if mailing direct) "mully" wrote in message ... Hi Gentlemen Thanks for all the info managed to get Managed to get both Duke & Bobs' working OK as there is different info Rich wasn't feasible --- just one query the info at the moment is entering columns & cells Z2/AA2 range for "ALTON" The question is if I had more info for "ALTON" it would have to go into columns AB/AC is it possible for the macro to search and find the first empty columns which would be AB/AC then do the business of entering the data which would always be in sheet "(RPRA") range "I2:J19) Once again Thanks --- Have a Happy & Prosperous 2006 Cheers Mully "Bob Phillips" wrote: Split the common stuff into a separate procedure, remove all the default settings etc. For example Sheets("RPRA").Select Columns("E:E").TextToColumns Destination:=Range("G1"), _ DataType:=xlDelimited, _ TextQualifier:=xlDoubleQuote, _ ConsecutiveDelimiter:=True, _ Tab:=False, Semicolon:=False, Comma:=True, _ Space:=False, Other:=True, _ FieldInfo:=Array(Array(1, 1), Array(2, 1), _ Array(3, 1), Array(4, 1)), _ TrailingMinusNumbers:=True FormatSheet Range("I316:J323"), Sheets("OLD GLOSSOP").Range("Z2") FormatSheet Range("I324:J338"), Sheets("PACKMOOR").Range("Z2") FormatSheet Range("I2:J19"), Sheets("ALTON").Range("Z2") End Sub Sub FormatSheet(Source As Range, Target As Range) Sheets("RPRA").Source.Copy Target With Target .Interior .ColorIndex = 40 .Pattern = xlSolid With .Borders(xlEdgeLeft) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With .Borders(xlEdgeTop) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With .Borders(xlEdgeBottom) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With .Borders(xlEdgeRight) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With .Borders(xlInsideVertical) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With .Borders(xlInsideHorizontal) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With .Font .Name = "Times New Roman" .Size = 10 .Font.Bold = True End With .HorizontalAlignment = xlCenter .VerticalAlignment = xlBottom End With End Sub -- HTH RP (remove nothere from the email address if mailing direct) "mully" wrote in message ... Hi All ---- Seasons Greetings Below is a macro I recorded it goes on for 23 Sheets --- I'm only showing the 1st three sheets in the macro--- is there a way of cutting down on all the code that is needed to run the full macro. Sheets("RPRA").Select Columns("E:E").Select Selection.TextToColumns Destination:=Range("G1"), DataType:=xlDelimited, _ TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=False, _ Semicolon:=False, Comma:=True, Space:=False, Other:=True, FieldInfo:= _ Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1)), TrailingMinusNumbers:= _ True Range("I316:J323").Select Selection.Copy Sheets("OLD GLOSSOP").Select Range("Z2").Select ActiveSheet.Paste With Selection.Interior .ColorIndex = 40 .Pattern = xlSolid End With Selection.Borders(xlDiagonalDown).LineStyle = xlNone Selection.Borders(xlDiagonalUp).LineStyle = xlNone With Selection.Borders(xlEdgeLeft) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With Selection.Borders(xlEdgeTop) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With Selection.Borders(xlEdgeBottom) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With Selection.Borders(xlEdgeRight) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With Selection.Borders(xlInsideVertical) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With Selection.Borders(xlInsideHorizontal) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With Selection.Font .Name = "Times New Roman" .Size = 10 .Strikethrough = False .Superscript = False .Subscript = False .OutlineFont = False .Shadow = False .Underline = xlUnderlineStyleNone .ColorIndex = xlAutomatic End With Selection.Font.Bold = True With Selection .HorizontalAlignment = xlCenter .VerticalAlignment = xlBottom .WrapText = False .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = False End With Sheets("RPRA").Select Range("I324:J338").Select Selection.Copy Sheets("PACKMOOR").Select Range("Z2").Select ActiveSheet.Paste With Selection.Interior .ColorIndex = 40 .Pattern = xlSolid End With Selection.Borders(xlDiagonalDown).LineStyle = xlNone Selection.Borders(xlDiagonalUp).LineStyle = xlNone With Selection.Borders(xlEdgeLeft) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With Selection.Borders(xlEdgeTop) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With Selection.Borders(xlEdgeBottom) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With Selection.Borders(xlEdgeRight) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With Selection.Borders(xlInsideVertical) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With Selection.Borders(xlInsideHorizontal) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With Selection.Font .Name = "Times New Roman" .Size = 10 .Strikethrough = False .Superscript = False .Subscript = False .OutlineFont = False .Shadow = False .Underline = xlUnderlineStyleNone .ColorIndex = xlAutomatic End With Selection.Font.Bold = True With Selection .HorizontalAlignment = xlCenter .VerticalAlignment = xlBottom .WrapText = False .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = False End With Sheets("RPRA").Select Range("I2:J19").Select Selection.Copy Sheets("ALTON").Select Range("Z2").Select ActiveSheet.Paste With Selection.Interior .ColorIndex = 40 |
#8
Posted to microsoft.public.excel.misc
|
|||
|
|||
Shorten a Macro
Fraid not, don't forget Chelsea can (will) buy more in January. Sorry state.
-- HTH RP (remove nothere from the email address if mailing direct) "mully" wrote in message ... Hi Bob Thanks for info will have a go tomorrow -- got visitors arriving shortly --- will either of catch Chelsea??? Cheers Mully "Bob Phillips" wrote: You can fine the first empty column number with iLastCol = Cells(2,Columns.Count).End(xlToLeft).Column and use this like so (in my version) FormatSheet Range("I2:J19"), Sheets("ALTON") End Sub Sub FormatSheet(Source As Range, Target As Worksheet) Dim iLastCol As Long iLastCol = Cells(2,Columns.Count).End(xlToLeft).Column Sheets("RPRA").Source.Copy Target.Cells(2,iLastCol) With Target -- HTH RP (remove nothere from the email address if mailing direct) "mully" wrote in message ... Hi Gentlemen Thanks for all the info managed to get Managed to get both Duke & Bobs' working OK as there is different info Rich wasn't feasible --- just one query the info at the moment is entering columns & cells Z2/AA2 range for "ALTON" The question is if I had more info for "ALTON" it would have to go into columns AB/AC is it possible for the macro to search and find the first empty columns which would be AB/AC then do the business of entering the data which would always be in sheet "(RPRA") range "I2:J19) Once again Thanks --- Have a Happy & Prosperous 2006 Cheers Mully "Bob Phillips" wrote: Split the common stuff into a separate procedure, remove all the default settings etc. For example Sheets("RPRA").Select Columns("E:E").TextToColumns Destination:=Range("G1"), _ DataType:=xlDelimited, _ TextQualifier:=xlDoubleQuote, _ ConsecutiveDelimiter:=True, _ Tab:=False, Semicolon:=False, Comma:=True, _ Space:=False, Other:=True, _ FieldInfo:=Array(Array(1, 1), Array(2, 1), _ Array(3, 1), Array(4, 1)), _ TrailingMinusNumbers:=True FormatSheet Range("I316:J323"), Sheets("OLD GLOSSOP").Range("Z2") FormatSheet Range("I324:J338"), Sheets("PACKMOOR").Range("Z2") FormatSheet Range("I2:J19"), Sheets("ALTON").Range("Z2") End Sub Sub FormatSheet(Source As Range, Target As Range) Sheets("RPRA").Source.Copy Target With Target .Interior .ColorIndex = 40 .Pattern = xlSolid With .Borders(xlEdgeLeft) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With .Borders(xlEdgeTop) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With .Borders(xlEdgeBottom) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With .Borders(xlEdgeRight) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With .Borders(xlInsideVertical) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With .Borders(xlInsideHorizontal) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With .Font .Name = "Times New Roman" .Size = 10 .Font.Bold = True End With .HorizontalAlignment = xlCenter .VerticalAlignment = xlBottom End With End Sub -- HTH RP (remove nothere from the email address if mailing direct) "mully" wrote in message ... Hi All ---- Seasons Greetings Below is a macro I recorded it goes on for 23 Sheets --- I'm only showing the 1st three sheets in the macro--- is there a way of cutting down on all the code that is needed to run the full macro. Sheets("RPRA").Select Columns("E:E").Select Selection.TextToColumns Destination:=Range("G1"), DataType:=xlDelimited, _ TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=False, _ Semicolon:=False, Comma:=True, Space:=False, Other:=True, FieldInfo:= _ Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1)), TrailingMinusNumbers:= _ True Range("I316:J323").Select Selection.Copy Sheets("OLD GLOSSOP").Select Range("Z2").Select ActiveSheet.Paste With Selection.Interior .ColorIndex = 40 .Pattern = xlSolid End With Selection.Borders(xlDiagonalDown).LineStyle = xlNone Selection.Borders(xlDiagonalUp).LineStyle = xlNone With Selection.Borders(xlEdgeLeft) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With Selection.Borders(xlEdgeTop) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With Selection.Borders(xlEdgeBottom) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With Selection.Borders(xlEdgeRight) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With Selection.Borders(xlInsideVertical) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With Selection.Borders(xlInsideHorizontal) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With Selection.Font .Name = "Times New Roman" .Size = 10 .Strikethrough = False .Superscript = False .Subscript = False .OutlineFont = False .Shadow = False .Underline = xlUnderlineStyleNone .ColorIndex = xlAutomatic End With Selection.Font.Bold = True With Selection .HorizontalAlignment = xlCenter .VerticalAlignment = xlBottom .WrapText = False .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = False End With Sheets("RPRA").Select Range("I324:J338").Select Selection.Copy Sheets("PACKMOOR").Select Range("Z2").Select ActiveSheet.Paste With Selection.Interior .ColorIndex = 40 .Pattern = xlSolid End With Selection.Borders(xlDiagonalDown).LineStyle = xlNone Selection.Borders(xlDiagonalUp).LineStyle = xlNone With Selection.Borders(xlEdgeLeft) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With Selection.Borders(xlEdgeTop) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With Selection.Borders(xlEdgeBottom) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With Selection.Borders(xlEdgeRight) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With Selection.Borders(xlInsideVertical) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With Selection.Borders(xlInsideHorizontal) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With Selection.Font .Name = "Times New Roman" .Size = 10 .Strikethrough = False .Superscript = False .Subscript = False .OutlineFont = False .Shadow = False .Underline = xlUnderlineStyleNone .ColorIndex = xlAutomatic End With Selection.Font.Bold = True With Selection .HorizontalAlignment = xlCenter .VerticalAlignment = xlBottom .WrapText = False .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = False End With Sheets("RPRA").Select Range("I2:J19").Select Selection.Copy Sheets("ALTON").Select Range("Z2").Select ActiveSheet.Paste With Selection.Interior .ColorIndex = 40 |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Can T Get Macro To Run! | New Users to Excel | |||
Closing File Error | Excel Discussion (Misc queries) | |||
Macro to shorten a list | Excel Discussion (Misc queries) | |||
Help with macro looping and color query function | Excel Discussion (Misc queries) | |||
Date macro | Excel Discussion (Misc queries) |