Results 1 to 9 of 9

Thread: Solved: need some advice please

Threaded View

Previous Post Previous Post   Next Post Next Post
  1. #9
    VBAX Master XLGibbs's Avatar
    Joined
    Jan 2006
    Location
    state of confusion, but vacation in denial
    Posts
    1,315
    Location

    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
  •