Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Need a slight modification to code
I am having an issue with the code below (bit beyond my skills, sorry)
While the code below is doing what it was designed to do (copy findings to another sheet) the problem I am having is when I do a second search of the "database" sheet the original search findings are removed or overwritten on the "Found" sheet. I would appreciate any ideas on how to stop further searches from overwriting the original findings and simply add them on to the end of the first search results. (hope this makes sense) Thanks, Dean Public Sub vbaCopyToAnotherSheetRealQuickLike() Dim rCell As Excel.Range Dim rRow As Excel.Range Dim wksFound As Excel.Worksheet Dim wksData As Excel.Worksheet Dim szLookupVal As String Dim szRowAddy As String Dim lRow As Long Set wksFound = Sheets("Found") 'Sheet that gets the copied data Set wksData = Sheets("Database") 'Sheet that contains the data to search lRow = wksFound.Cells(Rows.Count, 1).End(xlUp).Row szLookupVal = InputBox("What are you searching for", "Search-Box", "") If Len(szLookupVal) = 0 Then Exit Sub With wksData.Cells Set rCell = .Find(szLookupVal, , , , , , False) If Not rCell Is Nothing Then szRowAddy = rCell.Address Set rRow = rCell Do Set rCell = .FindNext(rCell) Set rRow = Application.Union(rRow, rCell) rRow.EntireRow.Copy wksFound.Cells(lRow, 1) Loop While Not rCell Is Nothing And rCell.Address < szRowAddy End If End With Set rCell = Nothing Set rRow = Nothing Set wksFound = Nothing Set wksData = Nothing End Sub |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
Need a slight modification to code
Try changing this line
lRow = wksFound.Cells(Rows.Count, 1).End(xlUp).Row to lRow = wksFound.Cells(Rows.Count, 1).End(xlUp).Row + 1 -- HTH Bob Phillips (remove nothere from email address if mailing direct) "Dean" wrote in message oups.com... I am having an issue with the code below (bit beyond my skills, sorry) While the code below is doing what it was designed to do (copy findings to another sheet) the problem I am having is when I do a second search of the "database" sheet the original search findings are removed or overwritten on the "Found" sheet. I would appreciate any ideas on how to stop further searches from overwriting the original findings and simply add them on to the end of the first search results. (hope this makes sense) Thanks, Dean Public Sub vbaCopyToAnotherSheetRealQuickLike() Dim rCell As Excel.Range Dim rRow As Excel.Range Dim wksFound As Excel.Worksheet Dim wksData As Excel.Worksheet Dim szLookupVal As String Dim szRowAddy As String Dim lRow As Long Set wksFound = Sheets("Found") 'Sheet that gets the copied data Set wksData = Sheets("Database") 'Sheet that contains the data to search lRow = wksFound.Cells(Rows.Count, 1).End(xlUp).Row szLookupVal = InputBox("What are you searching for", "Search-Box", "") If Len(szLookupVal) = 0 Then Exit Sub With wksData.Cells Set rCell = .Find(szLookupVal, , , , , , False) If Not rCell Is Nothing Then szRowAddy = rCell.Address Set rRow = rCell Do Set rCell = .FindNext(rCell) Set rRow = Application.Union(rRow, rCell) rRow.EntireRow.Copy wksFound.Cells(lRow, 1) Loop While Not rCell Is Nothing And rCell.Address < szRowAddy End If End With Set rCell = Nothing Set rRow = Nothing Set wksFound = Nothing Set wksData = Nothing End Sub |
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
Need a slight modification to code
Thanks Bob, worked a treat.
Dean |
#4
Posted to microsoft.public.excel.programming
|
|||
|
|||
Need a slight modification to code
Just noticed something else
Public Sub vbaCopyToAnotherSheetRealQuickLike() Dim rCell As Excel.Range Dim rRow As Excel.Range Dim wksFound As Excel.Worksheet Dim wksData As Excel.Worksheet Dim szLookupVal As String Dim szRowAddy As String Dim lRow As Long Set wksFound = Sheets("Found") 'Sheet that gets the copied data Set wksData = Sheets("Database") 'Sheet that contains the data to search lRow = wksFound.Cells(Rows.Count, 1).End(xlUp).Row szLookupVal = InputBox("What are you searching for", "Search-Box", "") If Len(szLookupVal) = 0 Then Exit Sub With wksData.Cells Set rCell = .Find(szLookupVal, , , , , , False) If Not rCell Is Nothing Then szRowAddy = rCell.Address Set rRow = rCell Do Set rCell = .FindNext(rCell) Set rRow = Application.Union(rRow, rCell) lRow = lRow + 1 rRow.EntireRow.Copy wksFound.Cells(lRow, 1) Loop While Not rCell Is Nothing And rCell.Address < szRowAddy End If End With Set rCell = Nothing Set rRow = Nothing Set wksFound = Nothing Set wksData = Nothing End Sub -- HTH Bob Phillips (remove nothere from email address if mailing direct) "Bob Phillips" wrote in message ... Try changing this line lRow = wksFound.Cells(Rows.Count, 1).End(xlUp).Row to lRow = wksFound.Cells(Rows.Count, 1).End(xlUp).Row + 1 -- HTH Bob Phillips (remove nothere from email address if mailing direct) "Dean" wrote in message oups.com... I am having an issue with the code below (bit beyond my skills, sorry) While the code below is doing what it was designed to do (copy findings to another sheet) the problem I am having is when I do a second search of the "database" sheet the original search findings are removed or overwritten on the "Found" sheet. I would appreciate any ideas on how to stop further searches from overwriting the original findings and simply add them on to the end of the first search results. (hope this makes sense) Thanks, Dean Public Sub vbaCopyToAnotherSheetRealQuickLike() Dim rCell As Excel.Range Dim rRow As Excel.Range Dim wksFound As Excel.Worksheet Dim wksData As Excel.Worksheet Dim szLookupVal As String Dim szRowAddy As String Dim lRow As Long Set wksFound = Sheets("Found") 'Sheet that gets the copied data Set wksData = Sheets("Database") 'Sheet that contains the data to search lRow = wksFound.Cells(Rows.Count, 1).End(xlUp).Row szLookupVal = InputBox("What are you searching for", "Search-Box", "") If Len(szLookupVal) = 0 Then Exit Sub With wksData.Cells Set rCell = .Find(szLookupVal, , , , , , False) If Not rCell Is Nothing Then szRowAddy = rCell.Address Set rRow = rCell Do Set rCell = .FindNext(rCell) Set rRow = Application.Union(rRow, rCell) rRow.EntireRow.Copy wksFound.Cells(lRow, 1) Loop While Not rCell Is Nothing And rCell.Address < szRowAddy End If End With Set rCell = Nothing Set rRow = Nothing Set wksFound = Nothing Set wksData = Nothing End Sub |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
modification to this code | Excel Discussion (Misc queries) | |||
Code modification help | Excel Worksheet Functions | |||
modification for the code | Excel Programming | |||
Code Modification | Excel Programming | |||
Modification to code | Excel Programming |