| Home | Forums | Reviews | Articles | Register |
 |
| Thread Tools | Rate Thread |
|
Guest
Posts: n/a
|
|
|
|
||
|
|
| |
|
Guest
Posts: n/a
|
|
|
|
|
||
|
Guest
Posts: n/a
|
|
|
|
|
||
|
Guest
Posts: n/a
|
|
|
|
|
||
|
Guest
Posts: n/a
|
|
|
|
|
||
|
Guest
Posts: n/a
|
I went through your code with a very fine tooth comb. took me over two
hours. This is what I found 1) The On Error statement is masking any errors that occur after the statement. Becuase you need it for the SHOWALLDATA if no filter are enabled I would recommend adding a On Error GoTo 0 to resume error checking 2) You added a Application.DisplayAlerts = False so the pop up for confirmation of the delete will not appear. I recommend turning it back On so that other warning messages will appear. 3) I prefer specifically references each sheet for every statement rather than select sheets to reduce errors in the code. Below is the way I would write the code. I wish people wouldn't use the style the Macro Recording in excel uses. The code is hard to follow and often it doubles amount of statement. Also I don't like using R1C1 referencing because it easy to make mistakes when you are trying to count over 10 columns. It is much easier to understand the code and debug when you reference the cells by A1 addressing. I can't guarentee that I didn't make a couple of mistakes in translating this code, but I tried hard not to make mistakes. Sub Test() Application.ScreenUpdating = False Application.DisplayAlerts = False Sheets("Working").Delete Application.DisplayAlerts = True Sheets.Add.Name = "Working" Application.CutCopyMode = False Sheets("Main").Range("B14:E200").Copy Sheets("Working").Range("A1").Select.PasteSpecial _ Paste:=xlPasteValues Sheets("Main").Range("H14:H200").Copy Sheets("Working").PasteSpecial _ Paste:=xlPasteValues Sheets("Main").Range("j14:k200").Copy With Sheets("Working") .Range("f1").PasteSpecial _ Paste:=xlPasteValues .Rows("1:1").Insert .Range("A1").Value = "CCM" .Range("B1").Value = "TC" .Range("C1").Value = "Qty" .Range("D1").Value = "Type" .Range("E1").Value = "Date" .Range("f1").Value = "PM Notes" .Range("g1").Value = "Trading Instructions" .Columns("C:C").Cut Destination:=.Columns("B:B") .Range("C1:E200").AdvancedFilter _ Action:=xlFilterCopy, _ CopyToRange:=.Range("H1"), _ Unique:=True .Range("L1").Formula = "=COUNTA(H1)" unqinq = .Range("L1").Value If unqinq > 2 Then Msg = "Inquiry has differing criteria." & _ "Filter like offers and resubmit." Style = vbOKOnly Title = " Bad Criteria" Message = MsgBox(Msg, Style, Title) Sheets("Main").Select Exit Sub End If End With ' Moves Data to offer sheet With Sheets("OFFER") .Range("B1:B3").ClearContents .Range("A15:l66").ClearContents .Range("F7:F11").ClearContents .Range("B1").Formula = "=SUM(Working!C)" .Range("B2").Formula = "=UPPER(Working!B7)" .Range("B3").Formula = "=Working!J2" .Range("B1:B3").Copy .Range("B1:B3").PasteSpecial _ Paste:=xlPasteValues End With With Sheets("Working") .Range("L2").Formula = "=COUNTA(A:A)" offercnt = .Range("L2").Value 'Moves acct # .Range("A2:A" & offercnt).Copy Sheets("OFFER").Range("A15").PasteSpecial _ Paste:=xlPasteValues .Range("B2:B" & offercnt).Copy Sheets("OFFER").Range("c15").PasteSpecial _ Paste:=xlPasteValues 'Moves PM Notes .Range("F2:F" & offercnt).Copy Sheets("OFFER").Range("e15").PasteSpecial _ Paste:=xlPasteValues 'Moves PM Notes .Range("G2:G" & offercnt).Copy Sheets("OFFER").Range("F15").PasteSpecial _ Paste:=xlPasteValues 'Lookup Custodial Acct &Trade Code offercnt = .Range("Q1").Value .Range("B15").Formula = _ "=VLOOKUP(LEFT(A15,4),[MANAGER.XLS]Client!$A:$C,3,0)" .Range("B15").Copy _ Destination:=.Range("B15:B" & (15 + offercnt - 1)) .Range("B15:B" & (15 + offercnt - 1)).Copy .Range("B15:B" & (15 + offercnt - 1)).PasteSpecial _ Paste:=xlPasteValues .Range("D15").Formula = _ "=VLOOKUP(LEFT(A15,4),[MANAGER.XLS]Client!$A:$M,13,0)" .Range("D15").Copy _ Destination:=.Range("D15  " & (15 + offercnt - 1)).Range("D15 " & (15 + offercnt - 1)).PasteSpecial _Paste:=xlPasteValues 'Write formulas for portfolio stats offcnt = .Range("Q1").Value .Range("G15").Formula = _ "=IF(ISERROR(VLOOKUP(A15,Stats!$A:$G,2,0))=TRUE," & _ "0,VLOOKUP(A15,Stats!$A:$G,2,0))" .Range("H15").Formula = _ "=IF(ISERROR(VLOOKUP(A15,Stats!$A:$G,3,0))=TRUE,0," & _ "VLOOKUP(A15,Stats!$A:$G,3,0))" .Range("I15").Formula = _ "=IF(ISERROR(VLOOKUP(A15,Stats!$A:$G,4,0))=TRUE,0," & _ "VLOOKUP(A15,Stats!$A:$G,4,0))" .Range("J15").Formula = _ "=IF(ISERROR(VLOOKUP(A15,Stats!$A:$G,5,0))=TRUE,0," & _ "VLOOKUP(A15,Stats!$A:$G,5,0))" .Range("K15").Formula = _ "=IF(ISERROR(VLOOKUP(A15,Stats!$A:$G,6,0))=TRUE,0," & _ "VLOOKUP(A15,Stats!$A:$G,6,0))" .Range("L15").Formula = _ "=IF(ISERROR(VLOOKUP(A15,Stats!$A:$G,7,0))=TRUE," & _ """"",VLOOKUP(A15,Stats!$A:$G,7,0))" .Range("G15:L15").Copy _ Destination:=.Range("G15:L" & (15 + offercnt - 1)) End With 'Copy over list of ticker holdings With Sheets("OFFER") Set LastCell = .Range("n15").End(xlDown) .Range(.Range("n15"), LastCell).ClearContents End With 'Filter out tickers from current account list With Sheets("Stats") On Error Resume Next .ShowAllData On Error GoTo 0 End With With Sheets("Main") totcnt = .Range("p9").Value .Range("b14:b" & (14 + totcnt - 2)).Copy End With With Sheets("Stats") .Range("N2").PasteSpecial _ Paste:=xlPasteValues accttickercnt = .Range("l4").Value .Range("O2").Formula = "=""=""&RIGHT(N2,4)" .Range("O2").Copy .Range("N2").PasteSpecial _ Paste:=xlPasteValues Rem Columns("O:O").Select Rem Application.CutCopyMode = False Rem Selection.ClearContents .Columns("J:K").AdvancedFilter _ Action:=xlFilterInPlace, _ CriteriaRange:=.Range("N1:N" & accttickercnt), _ Unique:=False Set LastCell = .Range("K1").End(xlDown) .Range(.Range("K1"), LastCell).Copy _ Destination:=.Range("O1").Select filtcnt2 = .Range("l6").Value On Error Resume Next .ShowAllData On Error GoTo 0 .Range("O1:O5").AdvancedFilter _ Action:=xlFilterCopy, _ CopyToRange:=Range("P1"), _ Unique:=True unqtickcnt = .Range("l5").Value .Range("O2:O" & (unqtickcnt - 2)).Copy End With With Sheets("OFFER") .Range("N15").PasteSpecial _ Paste:=xlPasteValues 'Sort ticker list Set LastCell = .Range("N14").End(xlDown) .Range("N14").Select .Range(.Range("N14"), LastCell).Sort _ Key1:=.Range("N14"), _ Order1:=xlAscending, _ Header:=xlGuess, _ OrderCustom:=1, _ MatchCase:=False, _ Orientation:=xlTopToBottom, _ DataOption1:=xlSortNormal 'Formating .Columns("A:L").EntireColumn.AutoFit .Range("A15").Select End With End Sub "mburkett" wrote: > On Jun 17, 12:19 pm, Joel <J...@discussions.microsoft.com> wrote: > > There are two things to do > > > > 1) Try doing the advance filtering manually. Use menu Data - Filter - > > Advance Filter. click the Copy box and the Unique box. The slect your > > source and desintation cells. This will indicate if there are other problems > > with the workbook > > > > 2) Place my one line of code in a new workbook in a one line macro. Put > > data in the cells O1:O5. The run the macro. > > > > Hopefully this will isolate where the problem lies. I think the code is good. > > > > > > > > "mburkett" wrote: > > > On Jun 17, 11:18 am, Joel <J...@discussions.microsoft.com> wrote: > > > > The code works in my worksheet using excel 2003. > > > > > > 1) Is the workbook shared? > > > > 2) Are you getting a compiler error or an excution error. What error > > > > message does excel display > > > > 3) Line will not execute if there is no data in column O > > > > 4) If you are getting a compiler error then replace with this line > > > > > > Range("O1:O5").AdvancedFilter Action:=xlFilterCopy, _ > > > > CopyToRange:=Range("P1"), _ > > > > Unique:=True > > > > > > I just added line continuation characters so the line will not wrap. > > > > > > "mburkett" wrote: > > > > > The following line was recorded in Excel but will not work in the > > > > > macro. Ideas? > > > > > > > Range("O1:O5").AdvancedFilter Action:=xlFilterCopy, > > > > > CopyToRange:=Range("P1" _ > > > > > ), Unique:=True > > > > > > > Thanks - Michael > > > > > > > Here is the whole macro (The line in question is toward the bottom): > > > > > > > Application.DisplayAlerts = False > > > > > Application.ScreenUpdating = False > > > > > Sheets("Working").Delete > > > > > Sheets.Add.Name = "Working" > > > > > Sheets("Main").Select > > > > > Range("B14:E200").Select > > > > > Selection.Copy > > > > > Sheets("Working").Select > > > > > > > Range("A1").Select > > > > > Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, > > > > > SkipBlanks _ > > > > > :=False, Transpose:=False > > > > > Range("E1").Select > > > > > Sheets("Main").Select > > > > > > > Range("H14:H200").Select > > > > > Application.CutCopyMode = False > > > > > Selection.Copy > > > > > Sheets("Working").Select > > > > > > > Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, > > > > > SkipBlanks _ > > > > > :=False, Transpose:=False > > > > > > > Sheets("Main").Select > > > > > Range("j14:k200").Select > > > > > Application.CutCopyMode = False > > > > > Selection.Copy > > > > > Sheets("Working").Select > > > > > Range("f1").Select > > > > > Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, > > > > > SkipBlanks _ > > > > > :=False, Transpose:=False > > > > > > > Rows("1:1").Select > > > > > Application.CutCopyMode = False > > > > > Selection.Insert Shift:=xlDown > > > > > Range("A1").Select > > > > > ActiveCell.FormulaR1C1 = "CCM" > > > > > Range("B1").Select > > > > > ActiveCell.FormulaR1C1 = "TC" > > > > > Range("C1").Select > > > > > ActiveCell.FormulaR1C1 = "Qty" > > > > > Range("D1").Select > > > > > ActiveCell.FormulaR1C1 = "Type" > > > > > Range("E1").Select > > > > > ActiveCell.FormulaR1C1 = "Date" > > > > > Range("f1").Select > > > > > ActiveCell.FormulaR1C1 = "PM Notes" > > > > > Range("g1").Select > > > > > ActiveCell.FormulaR1C1 = "Trading Instructions" > > > > > Columns("C:C").Select > > > > > Selection.Cut > > > > > Columns("B:B").Select > > > > > Selection.Insert Shift:=xlToRight > > > > > > > Range("C1:E200").AdvancedFilter Action:=xlFilterCopy, > > > > > CopyToRange:=Range( _ > > > > > "H1"), Unique:=True > > > > > > > Range("L1").Select > > > > > ActiveCell.FormulaR1C1 = "=COUNTA(C[-4])" > > > > > Range("L1").Select > > > > > unqinq = Selection.Value > > > > > If unqinq > 2 Then > > > > > > > Msg = "Inquiry has differing criteria. Filter like offers and > > > > > resubmit." > > > > > Style = vbOKOnly > > > > > Title = " Bad Criteria" > > > > > Message = MsgBox(Msg, Style, Title) > > > > > Sheets("Main").Select > > > > > Exit Sub > > > > > Else > > > > > End If > > > > > > > ' Moves Data to offer sheet > > > > > Sheets("OFFER").Select > > > > > Range("B1:B3").Select > > > > > Selection.ClearContents > > > > > Range("A15:l66").Select > > > > > Selection.ClearContents > > > > > Range("l15:l66").Select > > > > > Range("F7:F11").Select > > > > > Selection.ClearContents > > > > > > > Range("B1").Select > > > > > ActiveCell.FormulaR1C1 = "=SUM(Working!C)" > > > > > Range("B2").Select > > > > > > > ActiveCell.FormulaR1C1 = "=UPPER(Working!RC[7])" > > > > > Range("B3").Select > > > > > > > ActiveCell.FormulaR1C1 = "=Working!R[-1]C[8]" > > > > > > > Range("B1:B3").Select > > > > > Selection.Copy > > > > > Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, > > > > > SkipBlanks _ > > > > > :=False, Transpose:=False > > > > > > > Sheets("Working").Select > > > > > Range("L2").Select > > > > > ActiveCell.FormulaR1C1 = "=COUNTA(C[-11])" > > > > > Range("L2").Select > > > > > offercnt = Selection.Value > > > > > > > 'Moves acct # > > > > > Range("A2").Select > > > > > ActiveCell.Range("A1:A" & offercnt - 1).Select > > > > > Selection.Copy > > > > > Sheets("OFFER").Select > > > > > Range("A15").Select > > > > > Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, > > > > > SkipBlanks _ > > > > > :=False, Transpose:=False > > > > > > > 'Moves Qty > > > > > Sheets("Working").Select > > > > > Range("b2").Select > > > > > ActiveCell.Range("A1:A" & offercnt - 1).Select > > > > > Selection.Copy > > > > > Sheets("OFFER").Select > > > > > Range("c15").Select > > > > > Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, > > > > > SkipBlanks _ > > > > > :=False, Transpose:=False > > > > > > > 'Moves PM Notes > > > > > Sheets("Working").Select > > > > > Range("f2").Select > > > > > ActiveCell.Range("A1:A" & offercnt - 1).Select > > > > > Selection.Copy > > > > > Sheets("OFFER").Select > > > > > Range("e15").Select > > > > > Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, > > > > > SkipBlanks _ > > > > > :=False, Transpose:=False > > > > > > > 'Moves PM Notes > > > > > Sheets("Working").Select > > > > > Range("g2").Select > > > > > ActiveCell.Range("A1:A" & offercnt - 1).Select > > > > > Selection.Copy > > > > > Sheets("OFFER").Select > > > > > Range("f15").Select > > > > > Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, > > > > > SkipBlanks _ > > > > > :=False, Transpose:=False > > > > > > > 'Lookup Custodial Acct &Trade Code > > > > > Range("q1").Select > > > > > offercnt = Selection.Value > > > > > Range("B15").Select > > > > > ActiveCell.FormulaR1C1 = _ > > > > > "=VLOOKUP(LEFT(RC[-1],4),[MANAGER.XLS]Client!C1:C3,3,0)" > > > > > Range("B15").Select > > > > > Selection.Copy > > > > > ActiveCell.Range("A1:A" & offercnt).Select > > > > > ActiveSheet.Paste > > > > > Application.CutCopyMode = False > > > > > Selection.Copy > > > > > Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, > > > > > SkipBlanks _ > > > > > :=False, Transpose:=False > > > > > Range("D15").Select > > > > > Application.CutCopyMode = False > > > > > > > ActiveCell.FormulaR1C1 = _ > > > > > "=VLOOKUP(LEFT(RC[-3],4),[MANAGER.XLS]Client!C1:C13,13,0)" > > > > > > > Range("D15").Select > > > > > Selection.Copy > > > > > ActiveCell.Range("A1:A" & offercnt).Select > > > > > ActiveSheet.Paste > > > > > Application.CutCopyMode = False > > > > > Selection.Copy > > > > > Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, > > > > > SkipBlanks _ > > > > > :=False, Transpose:=False > > > > > > > 'Write formulas for portfolio stats > > > > > > > Range("Q1").Select > > > > > offcnt = Selection.Value > > > > > Range("G15").Select > > > > > ActiveCell.FormulaR1C1 = _ > > > > > "=IF(ISERROR(VLOOKUP(RC[-6],Stats!C1:C7,2,0))=TRUE, > > > > > 0,VLOOKUP(RC[-6],Stats!C1:C7,2,0))" > > > > > Range("H15").Select > > > > > ActiveCell.FormulaR1C1 = _ > > > > > "=IF(ISERROR(VLOOKUP(RC[-7],Stats!C1:C7,3,0))=TRUE, > > > > > 0,VLOOKUP(RC[-7],Stats!C1:C7,3,0))" > > > > > Range("I15").Select > > > > > ActiveCell.FormulaR1C1 = _ > > > > > "=IF(ISERROR(VLOOKUP(RC[-8],Stats!C1:C7,4,0))=TRUE, > > > > > 0,VLOOKUP(RC[-8],Stats!C1:C7,4,0))" > > > > > Range("J15").Select > > > > > ActiveCell.FormulaR1C1 = _ > > > > > "=IF(ISERROR(VLOOKUP(RC[-9],Stats!C1:C7,5,0))=TRUE, > > > > > 0,VLOOKUP(RC[-9],Stats!C1:C7,5,0))" > > > > > Range("K15").Select > > > > > ActiveCell.FormulaR1C1 = _ > > > > > "=IF(ISERROR(VLOOKUP(RC[-10],Stats!C1:C7,6,0))=TRUE, > > > > > 0,VLOOKUP(RC[-10],Stats!C1:C7,6,0))" > > > > > Range("L15").Select > > > > > ActiveCell.FormulaR1C1 = _ > > > > > "=IF(ISERROR(VLOOKUP(RC[-11],Stats! > > > > > C1:C7,7,0))=TRUE,"""",VLOOKUP(RC[-11],Stats!C1:C7,7,0))" > > > > > Range("M15").Select > > > > > > > Range("G15:L15").Select > > > > > Selection.Copy > > > > > > > ActiveCell.Range("A1:F" & offcnt).Select > > > > > Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, > > > > > _ > > > > > SkipBlanks:=False, Transpose:=False > > > > > Selection.Copy > > > > > Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, > > > > > _ > > > > > SkipBlanks:=False, Transpose:=False > > > > > Range("a15").Select > > > > > > > 'Copy over list of ticker holdings > > > > > Sheets("OFFER").Select > > > > > Range("n15").Select > > > > > Range(Selection, Selection.End(xlDown)).Select > > > > > Range(Selection, Selection.End(xlDown)).Select > > > > > Selection.ClearContents > > > > > > > 'Filter out tickers from current account list > > > > > Sheets("Stats").Select > > > > > On Error Resume Next > > > > > ActiveSheet.ShowAllData > > > > > Sheets("Main").Select > > > > > Range("p9").Select > > > > > totcnt = Selection.Value > > > > > Range("b14").Select > > > > > > > ActiveCell.Range("a1:a" & totcnt - 1).Select > > > > > Selection.Copy > > > > > Sheets("Stats").Select > > > > > > > Range("N2").Select > > > > > Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, > > > > > SkipBlanks _ > > > > > :=False, Transpose:=False > > > > > Range("l4").Select > > > > > accttickercnt = Selection.Value > > > > ... > > > > read more »- Hide quoted text - > > > > - Show quoted text - |
|
|
|
|
|||
|
|
| |
|
| Thread Tools | |
| Rate This Thread | |
|
|
Similar Threads
|
||||
| Thread | Thread Starter | Forum | Replies | Last Post |
| Advanced filter macro error | Boss | Microsoft Excel Programming | 3 | 7th Jan 2009 01:38 PM |
| Advanced filter macro | Boss | Microsoft Excel Programming | 3 | 11th Dec 2008 09:31 AM |
| Advanced Filter Macro | Alex.W | Microsoft Excel Misc | 1 | 4th Apr 2008 12:19 PM |
| Advanced Filter Macro | Dolphinv4 | Microsoft Excel Misc | 2 | 20th Mar 2008 11:42 AM |
| Using Advanced Filter through Macro | =?Utf-8?B?UHJhc2hhbnQgR2FyZw==?= | Microsoft Excel Programming | 4 | 18th Dec 2004 01:28 AM |
