Failing to write a search and cut and paste macro

**top_dog** · 03-17-2014, 03:08 AM

I have successfully wrote a few Macros from reading the information on this forum. This one has got me beat after 3 days trying to figure it out, can someone please help me otherwise I might smash my laptop

What I am trying to do is search for an identifying code and then cut in paste it into its own sheet. The macro needs to be able to grow and shrink as some weeks there might be 7 of them item and next 5, also sometimes there will be no data for that code. I think I have wrote a code that is pretty close but I am missing something

 For nidx = 0 To UBound(storeNos)
        Cells.Find(What:=storeNos(nidx), After:=ActiveCell, LookIn:=xlValues, LookAt:= _
        xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:= _
            True, SearchFormat:=True).Activate

Help will be much appreciated as I can then move on with my life lol

**nilem** · 03-17-2014, 03:28 AM

Hi top_dog,
try it

Sub ertert()
Dim s$, r
Application.ScreenUpdating = False
With Sheets("Data").Range("A1").CurrentRegion
    .Parent.AutoFilterMode = False: s = "~"
    For Each r In .Offset(1).Resize(.Rows.Count - 1).Columns(2).Value
        If InStr(s, "~" & r & "~") = 0 Then
            If Not Evaluate("ISREF('" & r & "'!A1)") Then
                Sheets.Add(after:=Sheets(Sheets.Count)).Name = r
            Else
                Sheets(r).UsedRange.ClearContents
            End If
            .AutoFilter 2, r
            .Copy Sheets(r).Range("A1")
            s = s & r & "~"
        End If
    Next
    .AutoFilter
End With: Application.ScreenUpdating = True
End Sub

**top_dog** · 03-17-2014, 04:17 AM

Man you did that so quick! Is there anyway to make it not make new tabs and use the ones I have already?

Many Thanks nilem, you have saved me so much headache.

**nilem** · 03-17-2014, 04:35 AM

try

Sub ertert()
Dim arr, i&
Application.ScreenUpdating = False
arr = Array("Ap", "Apple", "Ba", "Banana", "Pe", "Pear")
With Sheets("Data").Range("A1").CurrentRegion
    .Parent.AutoFilterMode = False
    For i = 0 To UBound(arr) Step 2
        .AutoFilter 2, arr(i)
'        Sheets(arr(i + 1)).UsedRange.ClearContents 'uncomment if needed
        .Copy Sheets(arr(i + 1)).Range("A1")
    Next i
    .AutoFilter
End With: Application.ScreenUpdating = True
End Sub

**top_dog** · 03-17-2014, 04:50 AM

Yep thats it, wow I was way off! You just saved me heaps of time!

Thanks again I am really grateful for you help

Failing to write a search and cut and paste macro

LinkBack

Thread Tools

Rate This Thread

Display

Hybrid View

Failing to write a search and cut and paste macro

Re: Failing to write a search and cut and paste macro

Re: Failing to write a search and cut and paste macro

Re: Failing to write a search and cut and paste macro

Re: Failing to write a search and cut and paste macro

Thread Information

Users Browsing this Thread

Similar Threads

[SOLVED] paste.special is failing

[SOLVED] How to write Macro that could cut and paste data

macro to search for unique value and write over that row, or write to next blank row.

Search or lookup function... attempting and failing

Bookmarks

Bookmarks

Posting Permissions