Reply
 
LinkBack Thread Tools Search this Thread Display Modes
  #1   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 36
Default 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   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 586
Default 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
Search this Thread:

Advanced Search
Display Modes

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
Streamlining sort A.R. Hunt Excel Discussion (Misc queries) 6 February 25th 08 05:10 PM
streamlining mttmwsn Excel Discussion (Misc queries) 9 October 29th 07 02:16 PM
Streamlining Code Camel Excel Programming 3 October 10th 06 07:57 AM
Streamlining a long IF=(AND formula ?? David.Allen297 Excel Discussion (Misc queries) 2 October 5th 05 12:16 PM
Streamlining Code Soundman Excel Discussion (Misc queries) 4 July 26th 05 02:42 PM


All times are GMT +1. The time now is 09:49 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"