PDA

View Full Version : Solved: need some advice please



mercmannick
01-19-2006, 02:15 PM
Sub S17_daily2()

Dim LastRow As Long

LastRow = Range("B65536").End(xlUp).Row


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
Columns("A:A").Delete Shift:=xlToLeft
Workbooks.Open Filename:="C:\cmo1 s17.xls", Origin:=xlWindows
Range("A9:A11142").FormulaR1C1 = _
"=VLOOKUP(RC[5],'[wip reportwk3.3.xls]wip reportwk3.3'!R12C1:R22826C13,1,0)"

Range("A9:S" & LastRow).Sort Key1:=Range("A9"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal

End Sub



What i am trying to do is


open wipreport, del col a,

open cm01 ,

do vlookup on

cm01 to wip ("=VLOOKUP(RC[5],'[wip reportwk3.3.xls]wip reportwk3.3'!R12C1:R22826C13,1,0)"
)


then on cm01 data sort the matches by col s

then sum up col m , totals if col s = anything beginning with B or I then give me 1 figure, then give me the remaining total of col m on the matches only ?


Dont know if this is possible

But im stuck

:banghead:

thanks

Merc

malik641
01-19-2006, 10:58 PM
Hey Merc,

Do the files contain sensitive data? If not could you post the books? If so.....do you think you could create a dummy example of what you have and what you want the outcome to be?

I think I follow what you're trying to do, but I got lost at the array section. I've never used the "Workbooks.OpenText" command. And I'm not sure why you are writing "OpenText" for an xls document and not a txt or doc document. Or maybe I'm just not following all together :think: but I'm trying :thumb.

I'm sure there can be an easier way to do this. And I'm more than willing to help.

mercmannick
01-20-2006, 06:43 AM
:banghead:

basically on files above


lookup from wip on col F
on matches data sort by col S
if col s begins with B or I give me one total
on the rest of matches give me the remaining total

so should have total for B & I ****
and total for rest ****


Many thanks

Merc

BDavidson
01-20-2006, 09:39 AM
What are you looking up in WIP (which column in cm01)?

mercmannick
01-20-2006, 09:49 AM
Sub S17_daily2()

Dim LastRow As Long




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

LastRow = Range("B65536").End(xlUp).Row


Columns("A:A").Delete Shift:=xlToLeft
Workbooks.Open Filename:="C:\cmo1 s17.xls", Origin:=xlWindows
Range("A9:A11142").FormulaR1C1 = _
"=VLOOKUP(RC[5],'[wip reportwk3.3.xls]wip reportwk3.3'!R12C1:R22826C13,1,0)"

Range("A9:S" & LastRow).sort Key1:=Range("A9"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal

End Sub


Sub count45()

With Rows("8:8")
.AutoFilter
.AutoFilter Field:=1, Criteria1:="<>#n/a", Operator:=xlAnd
.AutoFilter Field:=19, Criteria1:="<>*p*", Operator:=xlAnd, _
Criteria2:="<>*z*"
End With
With Range("M3")
.FormulaR1C1 = "=SUBTOTAL(9,R[6]C:R[10421]C)"
.Copy
.PasteSpecial Paste:=xlPasteValues
End With
Range("M5") = ""
Range("L3") = "imf"
With Range("M5")
.AutoFilter Field:=19
.AutoFilter Field:=19, Criteria1:="<>*b*", Operator:=xlAnd, _
Criteria2:="<>*i*"
End With
With Range("M2")
.FormulaR1C1 = "=SUBTOTAL(9,R[27]C:R[10423]C)"
.Copy
.PasteSpecial Paste:=xlPasteValues
End With
Range("L2") = "ws"
With Range("M1")
.FormulaR1C1 = "=SUBTOTAL(9,R[1]C:R[2]C)"
.Copy
.PasteSpecial Paste:=xlPasteValues
End With
Range("L1") = "total blog"
End Sub



Barrie

these 2 codes work okies now http://www.mrexcel.com/board2/images/smiles/icon_smile.gif

but i need to combine these 2gether,

because after i need to do ,another code.............


once i have info from above codes i need to......

goto wipreport. and data sort by col k

then delete anything that dosent begin with S17****

then vlookup on cm01,

on matches data sort col S, then give me total for anything in Col S that begins with B or I and another total for the Rest of matches


Hope this makes sense

and app your help

Merc

mercmannick
01-20-2006, 09:50 AM
Dont know if above code can be made smoother ,

as takes a lot of time to run at moment

Merc

BDavidson
01-20-2006, 10:25 AM
I have to step out for the rest of the day so can't get back to you today. I'll see if I can get on it this weekend.

Sorry.

mercmannick
01-20-2006, 10:34 AM
thanks M8

XLGibbs
01-22-2006, 10:36 AM
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. :dunno


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