P
puiuluipui
Hi, is there any way this macro display entire row?
This macro is searching in "C1:C1000" and display cells to the right.
Can this macro be made to display entire row when searched word is found?
Macro:
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address <> "$K$1" Then Exit Sub
Application.EnableEvents = False
Application.ScreenUpdating = False
With Sheets("Search")
lr = Application.Max(.Cells(Rows.Count, 1).End(xlUp).Row, 4)
..Range("a3:j" & lr).ClearContents
what = UCase(.Range("K1"))
On Error Resume Next
mydays = Array("ianuarie", "februarie", "martie", "aprilie", "mai", "iunie",
"iulie", "august", "septembrie", "octombrie", "noiembrie", "decembrie")
For Each sh In mydays
With Worksheets(sh).Range("C1:C1000")
Set c = .Find(what, LookIn:=xlValues, lookat:=xlPart)
If Not c Is Nothing Then
firstAddress = c.Address
Do
dlr = Sheets("Search").Cells(Rows.Count, "a").End(xlUp).Row + 1
c.Resize(, 8).Copy Sheets("Search").Cells(dlr, "a")
Sheets("search").Cells(dlr, "j") = Worksheets(sh).Name
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address <> firstAddress
End If
End With
Next sh
lr = .Cells(Rows.Count, 1).End(xlUp).Row
.Range("a3:j" & lr).Borders.LineStyle = xlNone
End With
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub
Can this be done?
Thanks!
This macro is searching in "C1:C1000" and display cells to the right.
Can this macro be made to display entire row when searched word is found?
Macro:
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address <> "$K$1" Then Exit Sub
Application.EnableEvents = False
Application.ScreenUpdating = False
With Sheets("Search")
lr = Application.Max(.Cells(Rows.Count, 1).End(xlUp).Row, 4)
..Range("a3:j" & lr).ClearContents
what = UCase(.Range("K1"))
On Error Resume Next
mydays = Array("ianuarie", "februarie", "martie", "aprilie", "mai", "iunie",
"iulie", "august", "septembrie", "octombrie", "noiembrie", "decembrie")
For Each sh In mydays
With Worksheets(sh).Range("C1:C1000")
Set c = .Find(what, LookIn:=xlValues, lookat:=xlPart)
If Not c Is Nothing Then
firstAddress = c.Address
Do
dlr = Sheets("Search").Cells(Rows.Count, "a").End(xlUp).Row + 1
c.Resize(, 8).Copy Sheets("Search").Cells(dlr, "a")
Sheets("search").Cells(dlr, "j") = Worksheets(sh).Name
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address <> firstAddress
End If
End With
Next sh
lr = .Cells(Rows.Count, 1).End(xlUp).Row
.Range("a3:j" & lr).Borders.LineStyle = xlNone
End With
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub
Can this be done?
Thanks!