Decrease file size

  • Thread starter Thread starter gavmer
  • Start date Start date
G

gavmer

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???
 
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
 
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!!
 
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.
 
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!!
 
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
 
Back
Top