-
More resolution
Okay, to close out issues from this thread here and a similar continuing topic Mr.Excel, the following code which eliminated much of the issues presented regarding the vlookup issues,the subtotal issues etc. the attached zip file includes the two files involved, the one with the code is the result file (the one attached is pre-execution) where the required results get performed and totaled in L1:03 . Some of it is commented out rather than deleted. The text import step was not tested by me, but that step produced the WIP excel file in the attached.
Some of the code was set up so that OP could modify it on his own, rather than really locking it down tight with more efficient array management.
The code runs in under 1 minute on XL2000 with 512 RAM, results are successful per the original poster.
Posted for the masses to either learn from , or help me learnmore from. 
[VBA]
Sub StartProcedures()
Dim wbWIP As Workbook, wbCMO As Workbook, rngLOOK As Range, rngFIND As Range
Dim rngMATCH As Range, a As Range, x As Double, y As Double, lRow As Long, rngSort As Range
Dim Stepnum As Integer, z As Double, q As Double
Stepnum = 1
' "C:\wip reportwk3.3.xls"
'Workbooks.OpenText Filename:="C:\wip reportwk3.3.xls", Origin:=xlMSDOS, _
' StartRow:=1, DataType:=xlFixedWidth, FieldInfo:=Array(Array(0, 1), Array(29 _
' , 1), Array(52, 1), Array(72, 1), Array(94, 1), Array(134, 1), Array(158, 1), Array(165, 1), _
' Array(183, 1), Array(196, 1), Array(200, 1), Array(205, 1), Array(210, 1), Array(215, 1)) _
' , TrailingMinusNumbers:=True
'
Call StopStuff(0) 'turns stuff FALSE, you can other things in there if needed.
For Each wb In Workbooks
wb.Activate
If Left(wb.Name, 3) = "wip" Then Set wbWIP = wb
If Left(wb.Name, 3) = "cmo" Then Set wbCMO = wb
Next wb
If wbWIP Is Nothing Or wbCMO Is Nothing Then GoTo ErrHandler 'if you don't have them open: STOP
'1 Delete column A from Wip file 'only if necessary, uncomment the lines
' With wbWIP.Sheets(1)
'Cells(1, 1).EntireColumn.Delete Shift:=xlToLeft
' End With
'MsgBox "Step1"
'2 match col F of CMO against A(After delete) of WIP
wbCMO.Activate: Set rngLOOK = wbCMO.Sheets(1).Range(Cells(9, 6), Cells(Rows.Count, 6).End(xlUp)) 'lookin col F of CMO
wbWIP.Activate: Set rngFIND = wbWIP.Sheets(1).Range(Cells(1, 2), Cells(Rows.Count, 2).End(xlUp)) 'match against col B of WIP
Stepnum = 2
For Each a In rngLOOK
If Not Trim(a) = "" Then
On Error GoTo ErrHandler
Set rngMATCH = rngFIND.Find(a)
If Not rngMATCH Is Nothing Then
a.Offset(, -5) = Left(rngMATCH, 6)
If Left(rngMATCH.Offset(, 11), 3) = "S17" Then a.Offset(, 14) = 1
Set rngMATCH = Nothing
End If
End If
Next a
Set a = Nothing
'3 delete non matches
Stepnum = 3 'delete rows with no match in column A
Again:
For Each c In rngLOOK.Offset(, -5) 'rngLook is column F..this moves it to column A
If c = "" Then
c.EntireRow.Delete
GoTo Again 'since row is deleted,must go back to catch consecutive rows.
End If
Next c
'4 sort on column s
''''''''''''''''''''''''''''''
'Stepnum = 4 'this step is no longer necessary if you want
'lRow = Cells(Rows.Count, 1).End(xlUp).row
'Set rngSort = Range(Cells(9, 1), Cells(lRow, 19))
'With rngSort
' .Sort Key1:=Range("S9"), Order1:=xlAscending, Header:=xlGuess, _
' OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
'End With
'''''''''''''''''''''''''''''''
Stepnum = 5
'5 total of anything beginning with B or I (column S), sum of column M, total into range M3
x = 0: y = 0: z = 0: q = 0 'set the variables at zero
For Each a In rngLOOK.Offset(, 13)
If UCase(Left(a, 1)) = "I" Or UCase(Left(a, 1)) = "B" Then
x = x + a.Offset(, -6) 'if match add up the col M
Else: y = y + a.Offset(, -6) 'if not match add up col M
End If
If a.Offset(, 1) = 1 Then 'check flag for S17 from WIP col L (no delete col A)
z = z + a.Offset(, -6)
Else: q = q + a.Offset(, -6)
End If
Next a
'6 and 7 , total of matches (x), and total of non matches (y)
Stepnum = 6
'''''''''''''''''''''''''''
wbCMO.Sheets(1).Range("L3:M3") = Array("IMF Total B/Log", x)
wbCMO.Sheets(1).Range("L2:M2") = Array("W/S Total B/Log", y)
wbCMO.Sheets(1).Range("L1:M1") = Array("Total", x + y)
wbCMO.Sheets(1).Range("O3:P3") = Array("IMF Actual B/Log", z)
wbCMO.Sheets(1).Range("O2:P2") = Array("W/S Actual B/Log", q)
wbCMO.Sheets(1).Range("O1:P1") = Array("Total", z + q)
'reset the variables
Set wbCMO = Nothing: Set wbWIP = Nothing: Set rngLOOK = Nothing: Set rngFIND = Nothing: Set rngSort = Nothing
Exit Sub
ErrHandler:
MsgBox "there was an error in Step:" & Stepnum
Call StopStuff(1)
End Sub
Private Sub StopStuff(ByVal x As Boolean)
'just to toggle stuff on boolean values
Application.ScreenUpdating = x
Application.EnableEvents = x
End Sub
[/VBA]
Last edited by XLGibbs; 01-22-2006 at 11:44 AM.
Posting Permissions
- You may not post new threads
- You may not post replies
- You may not post attachments
- You may not edit your posts
-
Forum Rules