Hi Excel Friends
I Need Help From You
I have applied this Below VBA to Copy Matched Data from Entire Row with to Given Sheet Name By InPutBox's here what happening this vba is copying matched data from entire workbook to given sheet name by inputbox successfully
Here what i want this VBA will Copy Matched Data From ActiveSheet only to Given Sheet Name By InPutBox Not from Entireworkbook Match
and one more if i given a sheet name by inputbox and the sheet is not exist in workbook then it will ask me by msgbox sheet not found do you want to create a sheet by given name then click yes
here i getting run time error when i type sheet name by inputbox and the sheet is not exist in workbook
Code
Sub SearchAll()
Dim ws As Worksheet, OutputWs As Worksheet
Dim rFound As Range, IsValueFound As Boolean, IsValueNotFound As Boolean
Dim strName As String
Dim count As Long, LastRow As Long
strName = Trim(InputBox("What are you looking for?"))
If strName = "" Then Exit Sub
Set OutputWs = Worksheets(InputBox("Enter Sheet Name"))
LastRow = OutputWs.Cells(Rows.count, "A").End(xlUp).row
For Each ws In Worksheets
If ws.Name <> OutputWs.Name Then
Debug.Print "Checking " & ws.Name
Set rFound = FindAll(ws.UsedRange, strName)
If Not rFound Is Nothing Then
Set rFound = rFound.EntireRow
count = rFound.Cells.count / Columns.count 'how many matched rows?
Debug.Print "Found " & count & " rows"
rFound.Copy OutputWs.Cells(LastRow + 1, 1)
LastRow = LastRow + count
IsValueFound = True
IsValueNotFound = True
End If
End If
Next ws
If IsValueFound Then
OutputWs.Select
MsgBox "Results pasted to " & "(" & OutputWs.Name & ")" & " Sheet"
Else
If IsValueNotFound Then
OutputWs = MsgBox("Sheet " & OutputWs.Name & " Not Found in WorkBook Do you want Create a New Sheet with Given Name Then Click Yes", vbQuestion + vbYesNo)
If OutputWs = vbYes Then
Worksheets.Add OutputWs.Name
End If
End If
End If
End Sub
Public Function FindAll(rng As Range, val As String) As Range
Dim rv As Range, f As Range
Dim addr As String
Set f = rng.Find(what:=val, After:=rng.Cells(rng.Cells.count), _
LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False)
If Not f Is Nothing Then addr = f.Address()
Do Until f Is Nothing
If rv Is Nothing Then
Set rv = f
Else
Set rv = Application.Union(rv, f)
End If
Set f = rng.FindNext(After:=f)
If f.Address() = addr Then Exit Do
Loop
Set FindAll = rv
End Function
