Hi all,

I have a completed workbook with which i am trying to decrease it
size. Would someone be willing to view my code and see to th
possibility of reducing its size??? Some people have said the code ca
be simplified.

Any takers???

--
Message posted from http://www.ExcelForum.com

Post your code and you will usually get some assistance for your reques

--
Message posted from http://www.ExcelForum.com

how big is the file?
"code" dont offten take up that much space, it's more likely to be formulas?


Ross

Hi all,

Here is my code. Maybe i could run it off 1 button (click event??)
Any ideas to shorten it???

thank you!!

Private Sub CommandButton1_Click()
CopyData Range("D9:D13"), "FEEDER"
CopyData Range("D16:D58"), "MACHINE"
CopyData Range("D63:D73"), "DELIVERY"
CopyData Range("D78:D82"), "PECOM"
CopyData Range("D88:D94"), "ROLLERS"
CopyData Range("D104:D128"), "MISCELLANEOUS"
End Sub
Private Sub CopyData(rngD As Range, Target As String)
Dim rng As Range, cell As Range
Dim rng1 As Range, rng2 As Range
Dim rng3 As Range
Dim nrow As Long, rw As Long
Dim Sh As Worksheet
nrow = Application.CountIf(rngD, "0")
If nrow = 0 Then Exit Sub
Set Sh = Worksheets("Quote2")
Set rng = Sh.Columns(1).Find(What:=Target, _
After:=Sh.Range("A1"), _
LookIn:=xlValues, _
LookAt:=xlPart, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
Set rng3 = rng
Worksheets("quote2").Unprotect Password:="jenjen1"
rng.Offset(1, 0).ClearContents
If Application.CountA(rng3) 2 Then
Else
Set rng3 = rng.Offset(2, 0)
End If
rw = rng3.Row
rng3.Resize(nrow * 2, 1).EntireRow.Insert
For Each cell In rngD
If Not IsEmpty(cell) Then
If IsNumeric(cell) Then
If cell 0 Then
Cells(cell.Row, 1).Resize(1, 2).Copy _
Destination:=Sh.Cells(rw, 1)
rw = rw + 2
End If
End If
End If
Next
Worksheets("quote2").Protect Password:="jenjen1"
End Sub
Private Sub Commandbutton2_click()
CopyData Range("E9:E128"), "OPTIONS"
End Sub
Private Sub CopyData2(rngE As Range, Target As String)
Dim rng As Range, cell As Range
Dim rng1 As Range, rng2 As Range
Dim rng3 As Range
Dim nrow As Long, rw As Long
Dim Sh As Worksheet
nrow = Application.CountIf(rngE, "0")
If nrow = 0 Then Exit Sub
Set Sh = Worksheets("Quote2")
Set rng = Sh.Columns(1).Find(What:=Target, _
After:=Sh.Range("A1"), _
LookIn:=xlFormulas, _
LookAt:=xlPart, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
Set rng3 = rng
Worksheets("quote2").Unprotect Password:="jenjen1"
rng.Offset(2, 0).ClearContents
If Application.CountA(rng3) 2 Then
Else
Set rng3 = rng.Offset(2, 0)
End If
rw = rng3.Row
rng3.Resize(nrow * 2, 0).EntireRow.Insert
For Each cell In rngE
If Not IsEmpty(cell) Then
If IsNumeric(cell) Then
If cell 0 Then
Cells(cell.Row, 1).Range("A9,B9").Copy _
Destination:=Sh.Cells(rw, 3)
rw = rw + 2
End If
End If
End If
Next
Worksheets("quote2").Protect Password:="jenjen1"
End Sub
Private Sub CommandButton3_Click()
CopyData Range("D9:D13"), "FEEDER"
CopyData Range("D16:D58"), "MACHINE"
CopyData Range("D63:D73"), "DELIVERY"
CopyData Range("D78:D82"), "PECOM"
CopyData Range("D88:D94"), "ROLLERS"
CopyData Range("D104:D128"), "MISCELLANEOUS"
Dim rng As Range, cell As Range
Dim nrow As Long, rw As Long
Dim col As String
Dim Sh As Worksheet
Set rng = Range("D9:D94")
nrow = Application.CountIf(rng, "0")
Set Sh = Worksheets("VK new")
rw = 10
For Each cell In Range("D9:D98")
If Cells(cell.Row, "D").Interior.ColorIndex = 3 Then
col = "G"
Else
col = "F"
End If
If Not IsEmpty(cell) Then
If IsNumeric(cell) Then
If cell 0 Then
Cells(cell.Row, 1).Copy
Sh.Cells(rw, "A").PasteSpecial Paste:=xlPasteValues
Cells(cell.Row, 4).Copy
Sh.Cells(rw, col).PasteSpecial Paste:=xlPasteValues
Cells(cell.Row, 2).Copy
Sh.Cells(rw, "B").PasteSpecial Paste:=xlPasteValues
Cells(cell.Row, 3).Copy
Sh.Cells(rw, "E").PasteSpecial Paste:=xlPasteValues
rw = rw + 1
End If
End If
End If
Next
For Each cell In Range("E9:E98")
If Not IsEmpty(cell) Then
If IsNumeric(cell) Then
If cell 0 Then
Cells(cell.Row, 1).Copy
Sh.Cells(rw, "A").PasteSpecial Paste:=xlPasteValues
Cells(cell.Row, 5).Copy
Sh.Cells(rw, "G").PasteSpecial Paste:=xlPasteValues
Cells(cell.Row, 2).Copy
Sh.Cells(rw, "B").PasteSpecial Paste:=xlPasteValues
Cells(cell.Row, 3).Copy
Sh.Cells(rw, "E").PasteSpecial Paste:=xlPasteValues
rw = rw + 1
End If
End If
End If
Next
End Sub


---
Message posted from http://www.ExcelForum.com/

You may want to check the used range of each of the sheets. I find that this
makes the file bigger than I expect.

Debra Dalgleish has some techniques to reset the last used cell at:
http://www.contextures.com/xlfaqApp.html#Unused

"gavmer <" wrote:

Hi all,

I have a completed workbook with which i am trying to decrease its
size. Would someone be willing to view my code and see to the
possibility of reducing its size??? Some people have said the code can
be simplified.

Any takers????

---
Message posted from http://www.ExcelForum.com/

--

Dave Peterson

Thank you all.

Can this code be downsized??? It is still very complicated to look at
Whilst im an amateur, it still looks to be repeating the same task bu
with a different range. Can it be simplified?? One button maybe???

Cheers!!

--
Message posted from http://www.ExcelForum.com

I took a look at CopyData2 and CopyData.

There was the obvious difference of rngD vs. rngE. But after I changed this, I
could see these differences:

LookIn:=xlFormulas, _
LookIn:=xlValues, _

rng.Offset(2, 0).ClearContents
rng.Offset(1, 0).ClearContents

rng3.Resize(nrow * 2, 0).EntireRow.Insert
rng3.Resize(nrow * 2, 1).EntireRow.Insert

Cells(cell.Row, 1).Range("A9,B9").Copy _
Cells(cell.Row, 1).Resize(1, 2).Copy _

Destination:=Sh.Cells(rw, 3)
Destination:=Sh.Cells(rw, 1)

The first one looks like it could be xlformulas in both routines.
The clearcontents looks different enough to me to be important.
The .entirerow.insert (resized to 0 columns looks like an error that should
be fixed)
the "a9,b9" and resize(1,2) are equivalent
the last one looks important.

You could pass a single routine a flag that says which way to process the data.

But if you're really looking to reduce the size of the workbook, try removing
all the code and saving the workbook. Then compare it to the same workbook with
the code. My bet is that it isn't significant.






"gavmer <" wrote:

Thank you all.

Can this code be downsized??? It is still very complicated to look at.
Whilst im an amateur, it still looks to be repeating the same task but
with a different range. Can it be simplified?? One button maybe???

Cheers!!!

---
Message posted from http://www.ExcelForum.com/

--

Dave Peterson

Hi Dave,

Thanks for taking a look. Copydata2 and Copydata are basically the sam
except that copydata2 references column E. Can these be incorporated i
some way??? Criteria for copydata is the one to base upon.

Thank you!!

--
Message posted from http://www.ExcelForum.com

You could pass a flag in the function call:

Private Sub CopyData(rngD As Range, Target As String)

would become:

Private Sub CopyData(rngD As Range, Target As String, myFlag as boolean)

then every spot that needs different processing would have to inspect that flag.

If myflag = true then
rng.Offset(2, 0).ClearContents
else
rng.Offset(1, 0).ClearContents
end if

kind of thing.

By making the flag a boolean variable, you'll get two choices--true or false.

If you need more, you could pass it a string (or a number):

Private Sub CopyData(rngD As Range, Target As String, myFlag as Long)

then when you need to make a difference:

select case myflag
case is = 1 : rng.Offset(2, 0).ClearContents
case is = 2 : rng.Offset(1, 0).ClearContents
'add as many as you'll need.
end select



"gavmer <" wrote:

Hi Dave,

Thanks for taking a look. Copydata2 and Copydata are basically the same
except that copydata2 references column E. Can these be incorporated in
some way??? Criteria for copydata is the one to base upon.

Thank you!!!

---
Message posted from http://www.ExcelForum.com/

--

Dave Peterson