Find Method Multiple Column

[asparagus]

Hello Master,

I want to find date for example "29-Nov-2014" with range (B7:F2000).
When i search date and show the result i want copy the result with range A7:EJ:2000)

this is my code

Sub Sample1()
  Dim oSht As Worksheet
  Dim lastRow As Long, i As Long
  Dim strSearch As String
  Dim t As Long
  Dim aCell As Range
 
  t = GetTickCount
  On Error GoTo Err
  Set oSht = Sheets("Monitoring List CKD NSeries")
  lastRow = oSht.Range("D" & Rows.count).End(xlUp).Row
  strSearch = Format(Date + 3, "dd-mmm-yy")
  Set aCell = oSht.Range("BD7: D" & lastRow).Find(What:=strSearch, LookIn:=xlValues, _
  LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
  MatchCase:=False, SearchFormat:=False)
 
 
  If Not aCell Is Nothing Then
  MsgBox "Value Found in Cell " & aCell.Address & vbCrLf & _
  "and it took " & GetTickCount - t & "milliseconds"
  End If
  Exit Sub
Err:
  MsgBox Err.Description
End Sub

and i upload my file excel to help running

Thanks
AsparAgus

 

[Smallman]

@asparagus

A small suggestion - insert a column in Col A - in A5 put your date (29 Nov) in A7 place this formula

=MATCH($A$5,C7:G7,0)

Drag down.

Now all you need is a filter - copy your data. Or if you are dead keen on VB for this simple task then this.

Sub Isolate()
    [A6:A2000].AutoFilter 1, ">0"
    [A6:G2000].Copy Sheet2.[A1]
End Sub

I was unsure of what you wanted copied as your code gave nothing away. Simply change to suit.

Take care

Smallman

 

[asparagus]

Hi @Smallman

This my update code to find date without filter

Sub SearchForString()
 
  Dim LSearchRow As Integer
  Dim LCopyToRow As Integer
  Dim LSearchValue As String
 
  On Error GoTo Err_Execute
 
  LSearchValue = Application.InputBox("Please enter a value to search for.", "Enter Date", Format(Now(), "dd-mmm-yy"))
  'Start search in row 4
  LSearchRow = 7
 
  'Start copying data to row 2 in Sheet2 (row counter variable)
  LCopyToRow = 2
 
  While Len(Range("A" & CStr(LSearchRow)).Value) > 0
 
  'If value in column E = LSearchValue, copy entire row to Sheet2
  If Range("B" & CStr(LSearchRow)).Value = LSearchValue Then
 
  'Select row in Sheet1 to copy
  Rows(CStr(LSearchRow) & ":" & CStr(LSearchRow)).Select
  Selection.Copy
 
  'Paste row into Sheet2 in next row
  Sheets("Sheet4").Select
  Rows(CStr(LCopyToRow) & ":" & CStr(LCopyToRow)).Select
  ActiveSheet.Paste
 
  'Move counter to next row
  LCopyToRow = LCopyToRow + 1
 
  'Go back to Sheet1 to continue searching
  Sheets("Monitoring List CKD F-Series").Select
  MsgBox "Data Found"
  End If
 
  LSearchRow = LSearchRow + 1
 
  Wend
  'Position on cell A3
  Application.CutCopyMode = False
  Range("A3").Select
 
 
 
  Exit Sub
 
Err_Execute:
  MsgBox "An error occurred."
 
End Sub

and the problem is, if i using this code in my file with name "search.xls" success to running and copy.
But if i use this code in file with name "example.xls" it doesn't succes.
Regards,
AsparAgus