Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Streamlining my code
Can someone help me with streamling the following code? I have other thing I
want to do with it (but that is for another time) I just don't want it to get out of control Sub Moving_Data() ' 'open Master Extraction File ' Workbooks.Open Filename:= _ "C:\Documents and Settings\johnsonl\My Documents\Master First Floor.xls" Columns("a:Z").Select Selection.Cut Range("b1").Select ActiveSheet.Paste Cells.Select Cells.EntireColumn.AutoFit Range("A1").Select ' 'Add ALD Sheet ' Sheets.Add Sheets("Sheet1").Select Sheets("Sheet1").Name = "ALD" Range("A1").Select Sheets("ALD").Select Sheets("ALD").Move After:=Sheets("Summary") Sheets("Summary").Select ' 'Add Visual Sheet ' Sheets.Add Sheets("Sheet2").Select Sheets("Sheet2").Name = "Visual" Range("A1").Select Sheets("Visual").Select Sheets("Visual").Move After:=Sheets("ALD") Sheets("Summary").Select Range("A1").Select ' 'copyheader to each sheet ' Rows("1:1").Select Selection.Copy Sheets("ALD").Select Rows("1:1").Select ActiveSheet.Paste Sheets("Visual").Select Rows("1:1").Select ActiveSheet.Paste Sheets("Summary").Select ' ' Set RowCount ' Sh1RowCount = 2 sh2RowCount = 2 Sh3RowCount = 2 ' ' Move Data ' With Sheets("Summary") Do While .Range("b" & Sh1RowCount) < "" If .Range("d" & Sh1RowCount) < "" Then .Rows(Sh1RowCount).Copy _ Destination:=Sheets("ald").Rows(sh2RowCount) sh2RowCount = sh2RowCount + 1 End If If .Range("k" & Sh1RowCount) < "" Then .Rows(Sh1RowCount).Copy _ Destination:=Sheets("visual").Rows(Sh3RowCount) Sh3RowCount = Sh3RowCount + 1 End If Sh1RowCount = Sh1RowCount + 1 Loop End With ' ' Autofit the columns ' Sheets("ALD").Select Cells.Select Cells.EntireColumn.AutoFit Range("A1").Select Sheets("Visual").Select Cells.Select Cells.EntireColumn.AutoFit Range("A1").Select Sheets("Summary").Select Range("A1").Select End Sub |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
Streamlining my code
I assume you are just wanting your code cleaned up. This should work.
Option Explicit Sub MoveStuff() Dim Sh1RowCount As Long Dim Sh2RowCount As Long Dim Sh3RowCount As Long ' open Master Extraction File Workbooks.Open Filename:="C:\Documents and Settings\johnsonl\My Documents\Master First Floor.xls" Columns("A:Z").Cut (ActiveSheet.Range("B1")) Cells.EntireColumn.AutoFit ' add new sheet Sheets.Add ' rename and move Sheet1 With Sheets("Sheet1") .Name = "ALD" .Move After:=Sheets("Summary") End With ' add new sheet Sheets.Add ' rename and move Sheet2 With Sheets("Sheet2") .Name = "Visual" .Move After:=Sheets("ALD") End With ' copyheader from Summary to Visual and ALD Sheets("Summary").Rows("1:1").Copy Sheets("Visual").Paste Destination:=Sheets("Visual").Range("A1") Sheets("ALD").Paste Destination:=Sheets("ALD").Range("A1") ' Move Data Sh1RowCount = 2 Sh2RowCount = 2 Sh3RowCount = 2 With Sheets("Summary") Do While .Range("B" & Sh1RowCount) < "" If .Range("D" & Sh1RowCount) < "" Then .Rows(Sh1RowCount).Copy (Sheets("ALD").Rows(Sh2RowCount)) Sh2RowCount = Sh2RowCount + 1 End If If .Range("K" & Sh1RowCount) < "" Then .Rows(Sh1RowCount).Copy (Sheets("Visual").Rows(Sh3RowCount)) Sh3RowCount = Sh3RowCount + 1 End If Sh1RowCount = Sh1RowCount + 1 Loop End With ' Autofit the columns Sheets("ALD").Cells.EntireColumn.AutoFit Sheets("Visual").Cells.EntireColumn.AutoFit Sheets("Summary").Select End Sub -- Cheers, Ryan "Novice Lee" wrote: Can someone help me with streamling the following code? I have other thing I want to do with it (but that is for another time) I just don't want it to get out of control Sub Moving_Data() ' 'open Master Extraction File ' Workbooks.Open Filename:= _ "C:\Documents and Settings\johnsonl\My Documents\Master First Floor.xls" Columns("a:Z").Select Selection.Cut Range("b1").Select ActiveSheet.Paste Cells.Select Cells.EntireColumn.AutoFit Range("A1").Select ' 'Add ALD Sheet ' Sheets.Add Sheets("Sheet1").Select Sheets("Sheet1").Name = "ALD" Range("A1").Select Sheets("ALD").Select Sheets("ALD").Move After:=Sheets("Summary") Sheets("Summary").Select ' 'Add Visual Sheet ' Sheets.Add Sheets("Sheet2").Select Sheets("Sheet2").Name = "Visual" Range("A1").Select Sheets("Visual").Select Sheets("Visual").Move After:=Sheets("ALD") Sheets("Summary").Select Range("A1").Select ' 'copyheader to each sheet ' Rows("1:1").Select Selection.Copy Sheets("ALD").Select Rows("1:1").Select ActiveSheet.Paste Sheets("Visual").Select Rows("1:1").Select ActiveSheet.Paste Sheets("Summary").Select ' ' Set RowCount ' Sh1RowCount = 2 sh2RowCount = 2 Sh3RowCount = 2 ' ' Move Data ' With Sheets("Summary") Do While .Range("b" & Sh1RowCount) < "" If .Range("d" & Sh1RowCount) < "" Then .Rows(Sh1RowCount).Copy _ Destination:=Sheets("ald").Rows(sh2RowCount) sh2RowCount = sh2RowCount + 1 End If If .Range("k" & Sh1RowCount) < "" Then .Rows(Sh1RowCount).Copy _ Destination:=Sheets("visual").Rows(Sh3RowCount) Sh3RowCount = Sh3RowCount + 1 End If Sh1RowCount = Sh1RowCount + 1 Loop End With ' ' Autofit the columns ' Sheets("ALD").Select Cells.Select Cells.EntireColumn.AutoFit Range("A1").Select Sheets("Visual").Select Cells.Select Cells.EntireColumn.AutoFit Range("A1").Select Sheets("Summary").Select Range("A1").Select End Sub |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Streamlining sort | Excel Discussion (Misc queries) | |||
streamlining | Excel Discussion (Misc queries) | |||
Streamlining Code | Excel Programming | |||
Streamlining a long IF=(AND formula ?? | Excel Discussion (Misc queries) | |||
Streamlining Code | Excel Discussion (Misc queries) |