PDA

View Full Version : Solved: Regressively search worksheets - similar to VLOOKUP's



Shaolin1976
05-09-2006, 03:09 AM
Hi all,

Johnske wrote some code to search Column A in all sheets of my workbook and copy each row which matched the desired string to another sheet as described on:

http://vbaexpress.com/forum/showthread.php?t=8008

And many, many thanks to Johnske for that :)

However, I now realise that it would be helpful if, as well as having the ability to search globally. I could just search the previous sheet (sheets are named 1 - 100) for the desired string (6 digit number found in column A, A6:A200) and populate the corresponding cells in it's row with the data found in that row on the previous sheet. I would like to have this work in the same way as VLOOKUP but without the huge computational effort and time loss that is associated with numerous (thousands) of VLOOKUP's.

The reason being that the data found on the previous sheet pertains to the previous month and this data will run on to the current and subsequent month(s); this data will not change from month to month.

So, to recap, is it possible for each worksheet (apart from the "SEARCH" sheet) to search only the previous worksheet for instances of a 6 digit number (in column A) and pull out the values in the corresponding cells in that row (B through Y) onto the next worksheet and have it do all of this automatically, i.e. without clicking a button or on Mouse Over and all of this without the CPU usage which comes with numerous VLOOKUPs

Nice and easy huh? hence my question. It's no problem if this is too complicated since I can make do with my VLOOKUPs but just thought I would ask the question anyway.

Many thanks

Shaolin

johnske
05-09-2006, 05:31 AM
You mean something like this? The code goes into the 'ThisWorkbook' code module (use one OR the other)

Caveats: Won't work on the first sheet cos there's no previous sheet to look at. Assumes there's only one such number on the previous sheet.

Dunno about "CPU usage", you'd have to test this...
Option Explicit
'
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim N As Long, Cell As Range
'
N = ActiveSheet.Index
'
If N = 1 Or Selection.Cells.Count > 1 Then Exit Sub
'
If Target.Column = 1 Then
Application.EnableEvents = False
'
With Sheets(N - 1).Columns(1)
Set Cell = .Find(Target.Value, LookIn:=xlValues, LookAt:=xlWhole)
If Not Cell Is Nothing Then
'
'copy entire row
Cell.EntireRow.Copy Sheets(N).Range(Target.Address)
'
End If
End With
'
Set Cell = Nothing
Application.EnableEvents = True
End If
'
End Sub

Alternatively,


Option Explicit
'
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
'
Dim N As Long, Cell As Range
'
N = ActiveSheet.Index
'
If N = 1 Or Selection.Cells.Count > 1 Then Exit Sub
'
If Target.Column = 1 Then
Application.EnableEvents = False
'
With Sheets(N - 1).Columns(1)
Set Cell = .Find(Target.Value, LookIn:=xlValues, LookAt:=xlWhole)
If Not Cell Is Nothing Then
'
'get the values only
Sheets(N).Range(Target.Offset(0, 1).Address, Target.Offset(0, 25).Address) _
= Sheets(N - 1).Range(Cell.Offset(0, 1).Address, Cell.Offset(0, 25).Address).Value
End If
End With
'
Set Cell = Nothing
Application.EnableEvents = True
End If
'
End Sub

Shaolin1976
05-09-2006, 06:21 AM
MANY MANY thanks Johnske,

It works perfectly! and although I have only tested it on a smaller workbook it works without the high CPU usage of numerous VLOOKUPs

For future workbooks how would I go about selectively pulling values from certain columns (sometimes non-contiguous) as opposed to the entire row?

i.e. if I wanted to populate values from columns A,B,D,E,G,H,J

but leave the values in columns C,F,I,K unchanged

Thanks again

Shaolin

NB the assumption that there is only one entry of each string per sheet is fine since that is indeed the case

johnske
05-09-2006, 07:10 AM
... For future workbooks how would I go about selectively pulling values from certain columns (sometimes non-contiguous) as opposed to the entire row?

i.e. if I wanted to populate values from columns A,B,D,E,G,H,J

but leave the values in columns C,F,I,K unchanged...Offhand, here's one way (Could possibly be made a little faster :dunno )

Option Explicit
'
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
'
Dim N As Long, M As Long, Cell As Range, MyColumnOffset As Variant
'
'column A is already catered for...
'column B is offset 1, column D is offset 3, column E is offset 4 etc.
MyColumnOffset = Array("1", "3", "4", "6", "7", "9")
'
N = ActiveSheet.Index
'
If N = 1 Or Selection.Cells.Count > 1 Then Exit Sub
'
If Target.Column = 1 Then
Application.EnableEvents = False
'
With Sheets(N - 1).Columns(1)
Set Cell = .Find(Target.Value, LookIn:=xlValues, LookAt:=xlWhole)
If Not Cell Is Nothing Then
'
'get the values only
For M = LBound(MyColumnOffset) To UBound(MyColumnOffset)
Sheets(N).Range(Target.Offset(0, MyColumnOffset(M)).Address) _
= Sheets(N - 1).Range(Cell.Offset(0, MyColumnOffset(M)).Address).Value
Next M
'
End If
End With
'
Set Cell = Nothing
Application.EnableEvents = True
End If
'
End Sub

Shaolin1976
05-09-2006, 07:35 AM
Thanks Johnske,

I tried selectively pulling non contiguous values using your original code by adding another couple of lines within the With statement:

Sheets(N).Range(Target.Offset(0, 3).Address, Target.Offset(0, 4).Address) _
= Sheets(N - 1).Range(Cell.Offset(0, 3).Address, Cell.Offset(0, 4).Address).Value
'
Sheets(N).Range(Target.Offset(0, 6).Address, Target.Offset(0, 6).Address) _
= Sheets(N - 1).Range(Cell.Offset(0, 6).Address, Cell.Offset(0, 6).Address).Valueand that seemed to do work, but your ammended code would be much easier if there are numerous noncontiguous cells to be copied.

Thanks again

Shaolin

johnske
05-09-2006, 07:45 AM
Not a prob. So can this be mark solved? :)