Out of the never ending searching?

[ellin00ra]

Somebody provided the code (thank YOU!) and works fine,except:

It searches information from a workbook...and does it sure.. But it also searches the sheet where it stores the previous finds.. So it'll never stop searching... I would be happy even with it searching sheet1 and only the whole column Z, and I don't need it to copy the info into a new book either...

Just started with vba and I am afraid oh deleting ay peace of code, coz that would mess up everything again
Can't move on with my exercise before this is solved...

Thanks for any help

 

[macleanb]

I dont know what your code looks like (perhaps post some!) but dont delete code - simply copy/paste the line (so you have two) and then put a ' (apostrophe) at the start of one of the lines - this will then turn green and be a comment (it is ignored) - that way you can always get it back again if your edits go awry....

 

[ellin00ra]

Hi , I thought I encluded it!! Sorry!!

Iam not this blurred normaly, im even blurried

Her's the code:
Private Sub CommandButton1_Click()




Dim oSheet As Object
Dim Firstcell As Range
Dim NextCell As Range
Dim WhatToFind As Variant
Dim rCopyCells As Range

On Error GoTo Err

Application.ScreenUpdating = False
Sheets("Temp").Select
Range("A2:BD65536").Select
Application.ScreenUpdating = True

WhatToFind = Application.InputBox("Search!", "Etsi", , 100, 100, , , 2)

If WhatToFind = False Then
Sheets("Vero").Select
End
End If

If WhatToFind <> "" And Not WhatToFind = False Then
For Each oSheet In ActiveWorkbook.Worksheets
oSheet.Activate
oSheet.[a1].Activate
Set Firstcell = Cells.Find(What:=WhatToFind, LookIn:=xlValues, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False)
If Not Firstcell Is Nothing Then
Firstcell.Activate
If MsgBox("Lisää tiedot", vbInformation + vbYesNo) = vbYes Then
ActiveCell.Select
Selection.EntireRow.Copy Destination:= _
Sheets("Temp").Range("A65536").End(xlUp).Offset(1, 0)

Set rCopyCells = Nothing
End If

On Error Resume Next
While (Not NextCell Is Nothing) And (Not NextCell.Address = Firstcell.Address)
Set NextCell = Cells.FindNext(After:=ActiveCell)
If Not NextCell.Address = Firstcell.Address Then
NextCell.Activate
If MsgBox("Add Record", vbInformation + vbYesNo) = vbYes Then
ActiveCell.Select
Selection.EntireRow.Copy Destination:= _
Sheets("Temp").Range("A65536").End(xlUp).Offset(1, 0)

End If
End If
Wend
End If
Set NextCell = Nothing
Set Firstcell = Nothing
Next oSheet
End If

Application.ScreenUpdating = False
Sheets("Temp").Select
Range("A2,AA1300").Select
Application.ScreenUpdating = True
Sheets("Vero").Select
Sheets("Temp").Copy
End
Err:
MsgBox "Virhe! Yritä uudelleen!!"
End

End Sub

 

[macleanb]

well you seem to have some vb there - I think all you need to do is test to make sure you are not on your "found" sheet

For Each oSheet In ActiveWorkbook.Worksheets
if oSheet.name <> "You results sheet" then

... all your code

endif

next oSheet

 

[ellin00ra]

Hi You there again! We gotta stop meeting like this!

I tried, it stops in the middle and says: Next without for??? I guess there 's a for missing but where

 

[macleanb]

-- For Each oSheet In ActiveWorkbook.Worksheets
if oSheet.name <> "You results sheet" then

... all your code

endif

--next oSheet


The -- lines are already in your code - yo didnt add them did you? also endif should actually be "end if" but the VBE should have sorted that out for you...

 

[ellin00ra]

Probably messed all up
too meny if's and ends...

I'll remove the previous code from my post and put the more messed up here

Private Sub CommandButton1_Click()




Dim oSheet As Object
Dim Firstcell As Range
Dim NextCell As Range
Dim WhatToFind As Variant
Dim rCopyCells As Range

On Error GoTo Err

Application.ScreenUpdating = False
    Sheets("Temp").Select
    Range("B2:B65536").Select
Application.ScreenUpdating = True

WhatToFind = Application.InputBox("Search!", "Etsi", , 100, 100, , , 2)

If WhatToFind = False Then
Sheets("Vero").Select
End
End If

If WhatToFind <> "" And Not WhatToFind = False Then
For Each oSheet In ActiveWorkbook.Worksheets
If oSheet.Name <> "Temp" Then
oSheet.Activate
oSheet.[a1].Activate
Set Firstcell = Cells.Find(What:=WhatToFind, LookIn:=xlValues, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False)
If Not Firstcell Is Nothing Then
Firstcell.Activate
If MsgBox("Lisää tiedot", vbInformation + vbYesNo) = vbYes Then
ActiveCell.Select
Selection.EntireRow.Copy Destination:= _
Sheets("Temp").Range("A65536").End(xlUp).Offset(1, 0)

Set rCopyCells = Nothing
End If

On Error Resume Next
While (Not NextCell Is Nothing) And (Not NextCell.Address = Firstcell.Address)
Set NextCell = Cells.FindNext(After:=ActiveCell)
If Not NextCell.Address = Firstcell.Address Then
NextCell.Activate
If MsgBox("Add Record", vbInformation + vbYesNo) = vbYes Then
ActiveCell.Select
Selection.EntireRow.Copy Destination:= _
Sheets("Temp").Range("A65536").End(xlUp).Offset(1, 0)

End If
End If
Wend
End If
Set NextCell = Nothing
Set Firstcell = Nothing
Next oSheet
End If

Application.ScreenUpdating = False
 Sheets("Temp").Select
 Range("A2,AA1300").Select
 Application.ScreenUpdating = True
 Sheets("Vero").Select
 Sheets("Temp").Copy
 End
Err:
MsgBox "Virhe! Yritä uudelleen!!"
End

End Sub

 

[macleanb]

Hi

I havent been very wholistic (I havent actually recreated what you are doing) but I have made a small change (you were missing an end if. Please check that it still works before you throw your old code away. I have done a couple of obvious (to me) tidy ups - but theres quite a lot more to do - but that can wait - you'll get there:

Option Explicit

Private Sub CommandButton1_Click()



Dim oSheet As Object
Dim Firstcell As Range
Dim NextCell As Range
Dim WhatToFind As Variant
Dim rCopyCells As Range

On Error GoTo Err

Application.ScreenUpdating = False
    Sheets("Temp").Select
    Range("B2:B65536").Select
Application.ScreenUpdating = True

WhatToFind = Application.InputBox("Search!", "Etsi", , 100, 100, , , 2)

If WhatToFind = False Or WhatToFind = "" Then
    Sheets("Vero").Select
    Exit Sub
End If

For Each oSheet In ActiveWorkbook.Worksheets
If oSheet.Name <> "Temp" Then
    oSheet.Activate
    oSheet.[a1].Activate
    Set Firstcell = Cells.Find(What:=WhatToFind, LookIn:=xlValues, LookAt _
    :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False)
    If Not Firstcell Is Nothing Then
        Firstcell.Activate
        If MsgBox("Lisää tiedot", vbInformation + vbYesNo) = vbYes Then
            ActiveCell.Select
            Selection.EntireRow.Copy Destination:= _
            Sheets("Temp").Range("A65536").End(xlUp).Offset(1, 0)
            Set rCopyCells = Nothing
        End If

        On Error Resume Next
        While (Not NextCell Is Nothing) And (Not NextCell.Address = Firstcell.Address)
            Set NextCell = Cells.FindNext(After:=ActiveCell)
            If Not NextCell.Address = Firstcell.Address Then
                NextCell.Activate
                If MsgBox("Add Record", vbInformation + vbYesNo) = vbYes Then
                    ActiveCell.Select
                    Selection.EntireRow.Copy Destination:= _
                    Sheets("Temp").Range("A65536").End(xlUp).Offset(1, 0)
                End If
            End If
        Wend
    End If
    Set NextCell = Nothing
    Set Firstcell = Nothing
End If

Next oSheet

Application.ScreenUpdating = False
Sheets("Temp").Select
Range("A2,AA1300").Select
Application.ScreenUpdating = True
Sheets("Vero").Select
Sheets("Temp").Copy
Exit Sub


Err:
MsgBox "Virhe! Yritä uudelleen!!"
Exit Sub


End Sub

 

[ellin00ra]

ray: You are a piece of gold! ray:

It did it
It still searches every columns even thoug i put B2:B60000 and somethin.
Then the opening a new book is unnesessary, cause the user will save the temp if so wanted...

But Thank You very much Mister!!!

 

[ellin00ra]

Happy too early
Still searches the temp file...