Please can anyone help on my problem
I have a macro that opens an input box where you insert a value, It then searches the columns for any match, after the matches are found the whole row is then copied into a seperate tab starting on cell A1. I would like the to copy into cell A7 onwards not A1.
Below is the VBA Code. Any help would be appreciated.
Dim Counter As Long
'-------------------------------------------------
'- SET SEARCH KEY
MyFind = InputBox("Please insert value to find.")
If MyFind = "" Then End
Counter = 0
'------------------------------------------------
'- FIND ALL MATCHING CELLS
On Error Resume Next
Set ws = ActiveSheet
Set FoundCell = ws.Cells.Find(what:=MyFind)
If Not FoundCell Is Nothing Then
FirstAddress = FoundCell.Address
Do
Counter = Counter + 1
'--------------------------------------------
'- what to do if found
FoundCell.Interior.ColorIndex = 4
FoundCell.EntireRow.Copy Destination:=Sheets("Results").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
'--------------------------------------------
Set FoundCell = ws.Cells.FindNext(FoundCell)
Loop While Not FoundCell Is Nothing _
And FoundCell.Address <> FirstAddress
LR = Range("A" & Rows.Count).End(xlUp).Row
On Error Resume Next
Range("A8:A" & LR).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
On Error GoTo 0
End If
rsp = MsgBox("Found " & Counter)
Sheets("Results").Select
Cells.Select
Selection.Columns.AutoFit
Range("A1").Select
Sheets("Sheet1").Select
End Sub
I have a macro that opens an input box where you insert a value, It then searches the columns for any match, after the matches are found the whole row is then copied into a seperate tab starting on cell A1. I would like the to copy into cell A7 onwards not A1.
Below is the VBA Code. Any help would be appreciated.
Dim Counter As Long
'-------------------------------------------------
'- SET SEARCH KEY
MyFind = InputBox("Please insert value to find.")
If MyFind = "" Then End
Counter = 0
'------------------------------------------------
'- FIND ALL MATCHING CELLS
On Error Resume Next
Set ws = ActiveSheet
Set FoundCell = ws.Cells.Find(what:=MyFind)
If Not FoundCell Is Nothing Then
FirstAddress = FoundCell.Address
Do
Counter = Counter + 1
'--------------------------------------------
'- what to do if found
FoundCell.Interior.ColorIndex = 4
FoundCell.EntireRow.Copy Destination:=Sheets("Results").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
'--------------------------------------------
Set FoundCell = ws.Cells.FindNext(FoundCell)
Loop While Not FoundCell Is Nothing _
And FoundCell.Address <> FirstAddress
LR = Range("A" & Rows.Count).End(xlUp).Row
On Error Resume Next
Range("A8:A" & LR).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
On Error GoTo 0
End If
rsp = MsgBox("Found " & Counter)
Sheets("Results").Select
Cells.Select
Selection.Columns.AutoFit
Range("A1").Select
Sheets("Sheet1").Select
End Sub