I have an ongoing project I have been working on. After making some
updates to it this week, the file suddenly started growing in size. It went
from 9700 kb to 14000 kb for no apparent reason. (This happens not
immediately after the changes are made, but after a few uses of the file) I
went back to a back up of the file, and rewrote the scripts and functions I
was working on, and the same thing happened.

Any ideas...

Updates that I made are.
1. Naming two 1800 cell ranges and applying data validation to those named
ranges.
2. Adjusting a simple logic formula in 15 cells.

3. Changes to a couple of scripts that import info from other excel files.

Thanks in advance.

AD108

I still don't know why, but...
I have managed to figure out that my problem is coming from running the
script below. The macro prompts for an import file, and then transfers data
from that file by matching item numbers. The fiirst procedure calls the
second one 16 times for each instance of the intColumn variable. Not sure
how, but it adds about 200 kb to the Workbook each time I run it.

Any help with this one would be greatly appreciated.



Sub Import_Prices()
Dim strFile As String
Dim wbThisBook As Workbook
Set wbThisBook = ThisWorkbook
Dim StrBook As String
Dim w As Workbook
Dim strWarning As String
Dim strWarning2 As String
intcolumn2 = 0

strWarning = "Warning, continuing with this step will SAVE and CLOSE all
other open Air Container"
strWarning = strWarning & " workbooks." & vbCrLf & "Click YES if you would
like to continue, click NO if you would "
strWarning = strWarning & "like to close your open Air Container" & vbCrLf &
"workbooks manually." & vbCrLf & vbCrLf
strWarning = strWarning & "
Continue ???"
strWarning2 = "The file you have chosen does not appear to be an Air
Container "
strWarning2 = strWarning2 & vbCrLf & "workbook. Are you sure you want to
import "
strWarning2 = strWarning2 & vbCrLf & "pricing from this file?"
If MsgBox(strWarning, vbYesNo) = vbYes Then

For Each w In Application.Workbooks
StrBook = w.Name
If StrBook & "\" & Workbooks(StrBook).Path = StrBook & "\" &
wbThisBook.Path Then
Else
If InStr(StrBook, "Air Container") = 0 Then
Else
w.Close SaveChanges:=True
End If
End If
Next w

Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual
Application.DisplayAlerts = False
'Get file from user and assign to variable
strFile = Application.GetOpenFilename(, , "Select the File to Import Pricing
From")
If strFile < "False" Then
If InStr(strFile, "Air Container") = 0 Then
If MsgBox(strWarning2, vbYesNo + vbCritical, "Warning, possible
incorrect file type!") = vbNo Then Exit Sub
End If
Set wbSource = Workbooks.Open(strFile)
'Copy Data from source book
'Loop through each range
wbSource.Activate
Sheets(2).Activate
Range("AO1:DZ1").Copy
wbThisBook.Activate
Sheets(2).Activate
Range("AO1").Select
ActiveSheet.Paste

Call ShowProgress

For intColumn = 1 To 16
PercentDone = (intColumn + intcolumn2) / 32
Call UpdateProgress(PercentDone)
wbSource.Activate
Sheets(2).Activate
If intColumn = 2 Then
If Len(strMsg) 141 Then
MsgBox strMsg, vbOKOnly
End If
End If
Select Case intColumn
Case 1
Range("A3:A450,AO3:AO450,AP3:AP450").Copy
Case 2
Range("A3:A450,AU3:AU450,AV3:AV450").Copy
Case 3
Range("A3:A450,BA3:BA450,BB3:BB450").Copy
Case 4
Range("A3:A450,BG3:BG450,BH3:BH450").Copy
Case 5
Range("A3:A450,BM3:BM450,BN3:BN450").Copy
Case 6
Range("A3:A450,BS3:BS450,BT3:BT450").Copy
Case 7
Range("A3:A450,BY3:BY450,BZ3:BZ450").Copy
Case 8
Range("A3:A450,CE3:CE450,CF3:CF450").Copy
Case 9
Range("A3:A450,CK3:CK450,CL3:CL450").Copy
Case 10
Range("A3:A450,CQ3:CQ450,CR3:CR450").Copy
Case 11
Range("A3:A450,CW3:CW450,CX3:CX450").Copy
Case 12
Range("A3:A450,DC3:DC450,DD3:DD450").Copy
Case 13
Range("A3:A450,DI3:DI450,DJ3:DJ450").Copy
Case 14
Range("A3:A450,DO3:DO450,DP3:DP450").Copy
Case 15
Range("A3:A450,DU3:DU450,DV3:DV450").Copy
Case 16
Range("A3:A450,AM3:AM450").Copy
End Select
wbThisBook.Activate
Range("EL3").Select
ActiveSheet.Paste

Call DataTransfer

Next intColumn

wbSource.Close SaveChanges:=False
Application.ScreenUpdating = True
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
Application.DisplayAlerts = True
Application.Calculate
Else: Exit Sub
End If
End If
End Sub

Sub DataTransfer()
Dim intPos As Integer
Dim i As Integer
Dim strMissing As String
Dim t() As Variant
Dim sht As Integer
Dim intLast As Integer
x = Range("EL3:EL450")
y = Range("EM3:EM450")
z = Range("EN3:EN450")

strMsg = "The following items were in your source file but were not found
in your Master Workbook."
strMsg = strMsg & vbCrLf & "You may wish to add them to your Master
Workbook." & vbCrLf
i = 1
On Error Resume Next
For i = 1 To UBound(x)
intPos = 0
intPos = Application.WorksheetFunction.Match(x(i, 1),
ActiveSheet.Range("A3:A450"), 0)
intPos = intPos + 2
If Not IsError(intPos) Then
If intPos = 2 Then
wbSource.Activate
strMissing = Range("A3:A450").Find(x(i,
1)).Offset(0, 2)
strMsg = strMsg & vbCrLf & strMissing
ThisWorkbook.Activate
'UserForm1.ListBox1.AddItem strMissing
Else
With ActiveSheet
intcolumn2 = intColumn
Select Case intcolumn2
Case 1
If y(i, 1) < "" Then
.Cells(intPos, 41) = y(i, 1)
End If
If z(i, 1) < "" Then
.Cells(intPos, 42) = z(i, 1)
End If
Case 2
If y(i, 1) < "" Then
.Cells(intPos, 47) = y(i, 1)
End If
If z(i, 1) < "" Then
.Cells(intPos, 48) = z(i, 1)
End If
Case 3
If y(i, 1) < "" Then
.Cells(intPos, 53) = y(i, 1)
End If
If z(i, 1) < "" Then
.Cells(intPos, 54) = z(i, 1)
End If
Case 4
If y(i, 1) < "" Then
.Cells(intPos, 59) = y(i, 1)
End If
If z(i, 1) < "" Then
.Cells(intPos, 60) = z(i, 1)
End If
Case 5
If y(i, 1) < "" Then
.Cells(intPos, 65) = y(i, 1)
End If
If z(i, 1) < "" Then
.Cells(intPos, 66) = z(i, 1)
End If
Case 6
If y(i, 1) < "" Then
.Cells(intPos, 71) = y(i, 1)
End If
If z(i, 1) < "" Then
.Cells(intPos, 73) = z(i, 1)
End If
Case 7
If y(i, 1) < "" Then
.Cells(intPos, 77) = y(i, 1)
End If
If z(i, 1) < "" Then
.Cells(intPos, 78) = z(i, 1)
End If
Case 8
If y(i, 1) < "" Then
.Cells(intPos, 83) = y(i, 1)
End If
If z(i, 1) < "" Then
.Cells(intPos, 84) = z(i, 1)
End If
Case 9
If y(i, 1) < "" Then
.Cells(intPos, 89) = y(i, 1)
End If
If z(i, 1) < "" Then
.Cells(intPos, 90) = z(i, 1)
End If
Case 10
If y(i, 1) < "" Then
.Cells(intPos, 95) = y(i, 1)
End If
If z(i, 1) < "" Then
.Cells(intPos, 96) = z(i, 1)
End If
Case 11
If y(i, 1) < "" Then
.Cells(intPos, 101) = y(i, 1)
End If
If z(i, 1) < "" Then
.Cells(intPos, 102) = z(i, 1)
End If
Case 15
If y(i, 1) < "" Then
.Cells(intPos, 107) = y(i, 1)
End If
If z(i, 1) < "" Then
.Cells(intPos, 108) = z(i, 1)
End If
Case 16
If y(i, 1) < "" Then
.Cells(intPos, 39) = y(i, 1)
End If
End Select
PercentDone = (intColumn + intcolumn2) / 32
Call UpdateProgress(PercentDone)
End With
End If
End If
Next i

If UserForm1.ListBox1.ListCount 0 Then
UserForm1.Show vbModeless
' Application.EnableEvents = True
' sht = ActiveSheet.Index
' intLast = Range("B9").End(xlDown).Row + 1
' 'intLast = GetLastRows(sht)
'
' For i = 0 To UserForm1.ListBox1.ListCount
' intLast = intLast + 1
' Cells(intLast, 2).Value = UserForm1.ListBox1.List(i)
' Next i
End If
End Sub
"AD108" wrote in message
...
I have an ongoing project I have been working on. After making some
updates to it this week, the file suddenly started growing in size. It
went from 9700 kb to 14000 kb for no apparent reason. (This happens not
immediately after the changes are made, but after a few uses of the file)
I went back to a back up of the file, and rewrote the scripts and
functions I was working on, and the same thing happened.

Any ideas...

Updates that I made are.
1. Naming two 1800 cell ranges and applying data validation to those
named ranges.
2. Adjusting a simple logic formula in 15 cells.

3. Changes to a couple of scripts that import info from other excel
files.

Thanks in advance.

AD108