Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
File Size Problem
Forgive the double posting, I think my last post may have been too poorly
written to be replied to. This time I have pasted the part of the code that I believe may be the culprit 1st, and then the entire procedures below. The code below has been causing my xl file to increase by 200kb each time its run. This part of the procedure below is where most of the data is written to the workbook. I'm guessing I am doing something wrong here. (These two procedures together prompt for file, and then transfer data from the file provided by the user, into the workbook. Initially the data is simply copied and pasted into the workbook from the source file, transfered into arrays, and is then matched up to the correct rows/columns by using a loop with the match function. ) There are three arrays. x() contains the item numbers to match, y() and z() are the data to transfer. Thanks in advance. Possible bad code...? 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 Full version of code below..... 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 |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Still problem with larg file size... | Excel Discussion (Misc queries) | |||
File Size Problem | Excel Worksheet Functions | |||
File Size Problem | Excel Programming | |||
File Size a real problem! | Excel Discussion (Misc queries) | |||
File size problem ??? | Excel Programming |