Hello,
I am trying to create a macro in excel and I am new to it. I am trying to have it where I search through a excel worksheet and I try to find a word in the sheet. if the word is found I cut the whole row and paste it to a brand new work sheet. then go back and search the original worksheet again and start the whole process over. If it does not find what I am looking for it will go to the next word find search. So far I got it finding the first word i was searching for but when it can not find that word anymore it asks to debug because of an object failure.
The code I used is below
Global X As Long
Global Y As String
Global A As String
Global N As String
Global V As Long
Global Find As Boolean
Sub SORT()
X = 2
Y = X
A = "A"
N = A & Y
'Adds New Workbook
Workbooks.Add
'Window 1 Activated
Windows("TRY1.xls").Activate
Rows("1:1").Select
Selection.Copy
' Activate new Workbook
Windows("Book1").Activate
Range("A1").Select
ActiveSheet.Paste
Range("A2").Select
ActiveCell.FormulaR1C1 = "TEST1"
Find = True
Windows("TRY1.xls").Activate
Do While Find = True
Find = Cells.Find(What:="IC", After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
, SearchFormat:=False).Activate
If Find = True Then
Rows(ActiveCell.Row).Select
Selection.Cut
Windows("Book1").Activate
X = X + 1
Y = X
N = A & Y
Range(N).Select
ActiveSheet.Paste
Windows("TRY1.xls").Activate
Range("E1").Select
Else
Find = Cells.Find(What:="LIC", After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
, SearchFormat:=False).Activate
If Find = True Then
Rows(ActiveCell.Row).Select
Selection.Cut
Windows("Book1").Activate
X = X + 1
Y = X
N = A & Y
Range(N).Select
ActiveSheet.Paste
Windows("TRY1.xls").Activate
Range("E1").Select
End If
End If
Loop
End Sub
Thank You for any help
JAY
Configuration: Windows XP Internet Explorer 6.0
Reply to venkat1926
|
Put all the unique names in an empty column/range for e.g. S2 down. row 1 is always for heading .
Sub test()
Dim r As Range, r1 As Range, c As Range, x As String
Dim cfind As Range, add As String
On Error Resume Next
Worksheets("sheet1").Activate
Set r = Range(Range("A1"), Range("A1").End(xlDown))
'this gets the unique name in column A and park it in column S
r.AdvancedFilter xlFilterCopy, copytorange:=Range("s1"), unique:=True
Set r1 = Range(Range("S2"), Range("s2").End(xlDown))
'MsgBox r1.Address
For Each c In r1
x = c.Value
Set cfind = r.Cells.Find(what:=x, lookat:=xlWhole)
add = cfind.Address
cfind.EntireRow.Copy Worksheets("sheet2").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
Do
Set cfind = r.Cells.FindNext(cfind)
If cfind Is Nothing Or cfind.Address = add Then Exit Do
cfind.EntireRow.Copy Worksheets("sheet2").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
Loop
Next c
End Sub
1.see the listing of unique names in column S using advanced filter. 2.loop over each name in column S 3.find the name available in column A 4. if found copy row to sheet 2 5.then loop to find same name somewhere else in column A see help under ADCVANCEDFILTER, FIND,FINDNEXT Preferably do not use variable names same as object or method names. Instead of find as variable use "cfin" or "found" etc. for advanced filter or autofilter column heading is necessary. |
Excel vba open file into existing worksheet Excel vba auto fill based on a number Excel vba clear content Excel vba conditional clear content Excel vba if cell contains Excel vba index number Excel vba insert row Excel vba range.cells( creates error Excel vba run macros when a cell changes Excel vba selection.offset paste Excel vba text duplication Excel vba timer Find range excel vba Format textboxes with multiple columns by using excel vba? How to convert rows into columns in excel vba How to get todays date from userform to excel vba Run excel vba schedule task Running oracle query from excel vba