Home |
Search |
Today's Posts |
#1
![]() |
|||
|
|||
![]()
I am just trying to write a macro to text to column and then copy 2 columns and add similar rows. somtimes, it works and sometimes i get debug error. here is my code. can someone please help!!
Sub PerShing() Sheets("Pershing").Select Columns("a:a").Select Selection.TextToColumns Destination:=Range("a1"), DataType:=xlFixedWidth, _ FieldInfo:=Array(Array(0, 1), Array(31, 1), Array(48, 1), Array(57, 1), Array(66, 1), _ Array(75, 1), Array(79, 1), Array(92, 1), Array(103, 1), Array(114, 1), Array(123, 1)), TrailingMinusNumbers:=True Range("a1").Select ActiveWindow.SmallScroll Down:=-108 'Delete extras For Each x In Range("B1:B100") If x = "SHS" Or x = "ADS" Or x = "COM" Or x = "COM NEW" Or x = "COM SHS" Or x = "COMMON" Or x = "common stock" Or x = "CL A" Or x = "REG SHS" Or x = "COM CL A" Or x = "COM USD SHS" Or x = "AMERICAN DEP SHS" Or x = "ADS RP ORD SHS" Or x = "SHS A" Or x = "CL A NEW" Or x = "SHS - A -" Or x = "SHA - A" Or x = "ORD SHS" Then x.Offset(0, 1).Value = "YES" Else x.Offset(0, 1).Value = "NO" Next x Application.ScreenUpdating = False 'Delete blank cells '# of rows ' DELETES ALL ROWS FROM A2 DOWNWARDS WITH THE WORDs "NO" IN COLUMN C '================================================= ======================= Last = Cells(Rows.Count, "C").End(xlUp).Row For i = Last To 1 Step -1 If (Cells(i, "C").Value) = "NO" Then 'Cells(i, "A").EntireRow.ClearContents ' USE THIS TO CLEAR CONTENTS BUT NOT DELETE ROW Cells(i, "A").EntireRow.Delete End If Next i ' Sort by SOLE Range("1:1").Select Selection.AutoFilter Range("A1").Select Selection.AutoFilter Field:=7, Criteria1:="=*SOLE*", Operator:=xlAnd ' Deletes CALL SOLE Last = Cells(Rows.Count, "G").End(xlUp).Row For i = Last To 1 Step -1 If (Cells(i, "G").Value) = "CALL SOLE" Then 'Cells(i, "A").EntireRow.ClearContents ' USE THIS TO CLEAR CONTENTS BUT NOT DELETE ROW Cells(i, "A").EntireRow.Delete End If Next i ' Deletes PUT SOLE Last1 = Cells(Rows.Count, "G").End(xlUp).Row For j = Last1 To 1 Step -1 If (Cells(j, "G").Value) = "PUT SOLE" Then 'Cells(j, "A").EntireRow.ClearContents ' USE THIS TO CLEAR CONTENTS BUT NOT DELETE ROW Cells(j, "A").EntireRow.Delete End If Next j 'Paste company name and number to final sheet Columns("a:a").Select Range(Selection, Selection.End(xlDown)).Select Selection.Copy Sheets("Final").Select Range("a6:a6").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Application.CutCopyMode = False Sheets("Pershing").Select Columns("e:e").Select Range(Selection, Selection.End(xlDown)).Select Selection.Copy Sheets("Final").Select Range("b6:b6").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Application.CutCopyMode = False Sheets("Final").Select Dim rng As Range, rData As Range Application.ScreenUpdating = False Set rData = Range("A6", Range("A6").End(xlDown)) rData.AdvancedFilter xlFilterCopy, copytorange:=Range("Y6"), unique:=True For Each rng In Range("Y6", Range("Y6").End(xlDown)) rng.Offset(, 1) = WorksheetFunction.SumIf(rData, rng, rData.Offset(, 1)) Next rng Range("Y:Z").Cut Range("A:B") End Sub |
Thread Tools | Search this Thread |
Display Modes | |
|
|
![]() |
||||
Thread | Forum | |||
Why am I getting "Code execution has been interrupted" message | Excel Programming | |||
Alien abduction of VB: "Code execution has been interrupted..." | Excel Programming | |||
VBA "Code execution interrupted" error on End Sub and End IF c0mmands?? | Excel Programming | |||
How to Diagnose Why "Code Execution has been interrupted" | Excel Programming |