RE: Complex Lookup Help

[dogeatdog01]

Hey guys!
first time here, and first post.
anyway - im usually a c++ man, and VB is verrrrry unnatural to me.

im in excel, and i have 2 sheets, one main sheet (sheet 1)..and a ref sheet (sheet 2).

i need to look up a value in sheet 1 B2, then have a look in sheet 2 in column A for that value..and if its equal (s1v = s2v), then i want the cell next to that one (in sheet 2), to be put in sheet 1 (next the matching one)

i hope that makes sense, and i hope my code makes sense
anyway - its slow, real slow (because i have 4000 cells to find)
is there a more efficient way to do this?
thanks for ure help
timmy

[dogeatdog01]

Private Sub unit1sort_Click()
Dim loop1 As Integer
Dim loop2 As Integer
Dim s1v As String
Dim s2v As String
Sheets("Sheet 1").Activate
Range("B2").Activate
arg:
For loop1 = 0 To 4000
s1v = Range("B2").Offset(loop1, 0).Value
Sheets("Sheet 2").Activate
Sheets("Sheet 2").Range("A2").Activate
For loop2 = 0 To 3500
Sheets("Sheet 2").Range("A2").Offset(loop2, 0).Activate
s2v = ActiveCell.Value


If s1v = s2v Then
Sheets("Sheet 1").Activate
Range("B2").Offset(loop1, 4).Value = s2v
End If
If loop2 = 3500 Then
loop1 = loop1 + 1
loop2 = 0
GoTo arg
End If

Next
Next

[rory]

You can use:
=VLOOKUP(B2,Sheet2!$A$1:$B$5000,2,FALSE)
in C2 on Sheet1 and copy down. Adjust the row numbers for your lookup range as required.

[charlesa920]

you could use a named range in rory's to replace the second argument in the vlookup (Sheet2!$A$1:$B$5000). pretty easy stuff.

[rbrhodes]

Hi DED01,

Looping 4000 * 3500 times = a long wait... Especially since screenupdating is still on!

Try this snippet. Simply copy to the same place as your original code. Rename your original sub with an extra character eg "Private Sub unitsort1_Click()". Then Click on your button to run this code.

It turns off screen updates temporarily, uses a single loop on all found values in "Sheet 1 " and uses a 'find' command on "Sheet 2".

Note: Your code has Sheet 1 and Sheet 2 as sheet names so I used them (the spaces in the names). If you get a 'Subscript out of range' error, check the sheet names.

I think you'll find it somewhat faster <G>


[VBA]
Private Sub unit1sort_Click()
Dim s1v As String
Dim loop1 As Long
Dim foundIt As Long
Dim lastRow As Long
Dim ws1 As Worksheet
Dim ws2 As Worksheet
'build short names for sheets
'NOTE space in name! (as per your code)
Set ws1 = Sheets("Sheet 1")
Set ws2 = Sheets("Sheet 2")
'speed
Application.ScreenUpdating = False
'clear errors for find command

'use object
With ws1
'clear old Col F
.Range("F:F").ClearContents
'get last row of data Sheet 1
lastRow = .Range("B65536").End(xlUp).Row
'start at row 2, go until last row
For loop1 = 2 To lastRow
'get current cell value
s1v = .Cells(loop1, 2)
'allow "not found" error
On Error Resume Next
'attempt to find in sheet 2
foundIt = ws2.Cells.Find(What:=s1v, After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:=False).Row
'if found, duplicate to Sheet 1, Col F
If Err = 0 Then
.Cells(loop1, 6) = s1v
Err = 0
End If
Next
End With

'reset
Application.ScreenUpdating = False
Set ws1 = Nothing
Set ws2 = Nothing

End Sub
[/VBA]

[cchris_uk]

I have a similar request and am unsure if I should create a new post.

What I need to be able to do is to look at a value in column B on sheet 1, see if this value exists on row 1 on sheet 2 and if it exiists do the following:

Check the value of the A column from the same row on sheet 1 and where it matches either V1 or V3, copy the range *2:*8 of the column in sheet 2, transposed, to the following row on sheet 1; or if V2 or V4 exists, copy/transpose *10:*16 instead.

This has to be looped until all rows on sheet 1 have been checked.

There may be cases where no corresponding data exists on sheet 2, so in this case, the data extraction for that particular row should be skipped.


I know I may of made a mess of explaining what I need to do, so I have included an example spreadsheet containing sample sheets 1 and 2, plus sheet 3 showing what the end result should look like.

Thanks for any assistance or guidance that you can offer!

Chris

[Bob Phillips]

[vba]

Sub ProcessData()
Dim LastRow As Long
Dim MatchCol As Long
Dim NextRow As Long
Dim TargetSheet As Worksheet
Dim i As Long, j As Long


Set TargetSheet = Worksheets.Add(after:=Worksheets(Worksheets.Count))

With Worksheets("examplesheet1")

LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
NextRow = 0
For i = 1 To LastRow

If .Cells(i, "B").Value <> "" Then

NextRow = NextRow + 1
.Rows(i).Copy TargetSheet.Cells(NextRow, "A")

MatchCol = 0
On Error Resume Next
MatchCol = Application.Match(.Cells(i, "B").Value, Worksheets("examplesheet2").Rows(1), 0)
On Error GoTo 0

NextRow = NextRow + 1
If MatchCol > 0 Then

For j = 1 To Worksheets("examplesheet2").Cells(1, MatchCol).End(xlDown).Row

Worksheets("examplesheet2").Cells(j, MatchCol).Copy TargetSheet.Cells(NextRow, j + 1)
Next j
End If
End If
Next i
End With

End Sub
[/vba]

[cchris_uk]

Wow, that response was awesome.
I have been trying to understand how it works fully, and it is obvious that I need to get myself some decent books.

With respect to my original post, is it possible to be more selective of the copied data from the columns in sheet2? eg, select data from rows 2,3,5 and 8 only?

And also, is it possible to perform a check the value in column A in sheet1 in order to alter the data pulled from sheet2? eg, data from rows 4,6,7 and 9?

Would it be better to split the subroutine into smaller subroutines that are called from each other?

The last programming experience I had wa assembler on an 8085 processor.

Regards,
Chris

[Bob Phillips]

First question.

[vba]

Sub ProcessData()
Dim LastRow As Long
Dim MatchCol As Long
Dim NextRow As Long
Dim NextCol As Long
Dim TargetSheet As Worksheet
Dim i As Long, j As Long
Dim RowsToCopy As Variant

RowsToCopy = Array(2, 3, 5, 8)


Set TargetSheet = Worksheets.Add(after:=Worksheets(Worksheets.Count))

With Worksheets("examplesheet1")

LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
NextRow = 0
For i = 1 To LastRow

If .Cells(i, "B").Value <> "" Then

NextRow = NextRow + 1
.Rows(i).Copy TargetSheet.Cells(NextRow, "A")

MatchCol = 0
On Error Resume Next
MatchCol = Application.Match(.Cells(i, "B").Value, Worksheets("examplesheet2").Rows(1), 0)
On Error GoTo 0

NextRow = NextRow + 1
NextCol = 1
If MatchCol > 0 Then

For j = 1 To Worksheets("examplesheet2").Cells(1, MatchCol).End(xlDown).Row

If Not IsError(Application.Match(j, RowsToCopy, 0)) Then

NextCol = NextCol + 1
Worksheets("examplesheet2").Cells(j, MatchCol).Copy TargetSheet.Cells(NextRow, NextCol)
End If
Next j
End If
End If
Next i
End With

End Sub
[/vba]

Second question - I don't understand what you ean.

Third question - the procedure is not substantial enough to split-up IMO.

I programmed the 8085 as well, I wrote a Basic Screen Editor in the days of line editors.

[rbrhodes]

Hi cchris,

This is a lot longer version but it may be more understandable to a novice. Read the comments in the code and let me know if you have questions about what it's doing.

XLD's code is far superior to this approach but it sound like you're curious so I'm posting this as something to look at when you get those books <G>.

Note: It doesn't create a new sheet, it clears old the data from Sheet 1 then copies from Sheet 2 to Sheet 1.

[cchris_uk]

Thank you rbrhodes, I will be loading that up at work tomorrow and having a gander!

xld - I had tried to alter your original response to try and do what you did here, but had used the command:

DIM rowstocopy AS Array
I then set rowstocopy = Range()

But became horribly confused!

For my second question, I will rephrase it:

I want to use two parameters from sheet1 with which to select the relevant data in sheet2.

So that if for example (A1(sheet1) = (V1 or V3)) and (B2(sheet1) = a1234), then search for column in sheet2 containing a1234 and copy data from one array of cells to sheet1, but if (A1(sheet1) = (V2 or V4)) and (B2(sheet1) = a1234) then copy data from a different array of cells to sheet1


Hope I made more sense that time, things seems so much easier to explain in my mind!

Chris

[Bob Phillips]

[vba]

Sub ProcessData()
Dim LastRow As Long
Dim MatchCol As Long
Dim NextRow As Long
Dim NextCol As Long
Dim TargetSheet As Worksheet
Dim i As Long, j As Long
Dim RowsToCopy As Variant
Dim ValuesToCheck As Variant

Set TargetSheet = Worksheets.Add(after:=Worksheets(Worksheets.Count))

With Worksheets("examplesheet1")

RowsToCopy = .Range("I1:I4")
ValuesToCheck = .Range("J1:J2")

LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
NextRow = 0
For i = 1 To LastRow

If .Cells(i, "B").Value <> "" Then

If Not IsError(Application.Match(.Cells(i, "A").Value, ValuesToCheck, 0)) Then

NextRow = NextRow + 1
.Rows(i).Copy TargetSheet.Cells(NextRow, "A")

MatchCol = 0
On Error Resume Next
MatchCol = Application.Match(.Cells(i, "B").Value, Worksheets("examplesheet2").Rows(1), 0)
On Error GoTo 0

NextRow = NextRow + 1
NextCol = 1
If MatchCol > 0 Then

For j = 1 To Worksheets("examplesheet2").Cells(1, MatchCol).End(xlDown).Row

If Not IsError(Application.Match(j, RowsToCopy, 0)) Then

NextCol = NextCol + 1
Worksheets("examplesheet2").Cells(j, MatchCol).Copy TargetSheet.Cells(NextRow, NextCol)
End If
Next j
End If
End If
End If
Next i
End With

End Sub
[/vba]

[cchris_uk]

Sweet!

Thats has given me something to play with, with any luck, I will be able to compare all the changes made thus far and come to a better understanding of how it all works, unfortunately for me, I do not have excel on my home machine so I will have to try these scripts out tomorrow morning.

Thank you for you help so far.

Regards,
Chris

[cchris_uk]

Hi there, I have been working on this code on and off all day and have managed to grasp just enough to start to cobble together different chunks of code (ala' Frankenstein's Monster!)

The following almost works perfectly, except the cells in the two arrays are not being kept in the required order.

What I mean is, the code seems to be copying and pasting the data in order numerical order, or the order to comes across it as it searches down the columns.

Is there a way to ensure the order as listed in the array is the order in which the data is extracted?

Also, this code is very fast at the moment, and I don't think it needs optimising, but for learning benefit, is there a way to make the code more efficient?

Code follows:


[vba]Sub Loopy()

Dim i As Long, j As Long
Dim lastRow As Long
Dim foundCol As Long
Dim nextCol As Long
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim mValue As String
Dim lookFor As String
Dim RowsToCopyOddPath As Variant
Dim RowsToCopyEvenPath As Variant

RowsToCopyOddPath = Array(404, 403, 980, 983, 655, 645, 389, 460, 494, 522, 550, 564, 578, 606, 398, 390, 392, 393, 523, 525, 526, 579, 581, 582, 503, 495, 497, 498, 469, 461, 463, 464, 388, 376, 377, 1017, 1088, 1122, 1150, 1178, 1192, 1206, 1234, 1026, 1018, 1020, 1021, 1151, 1153, 1154, 1207, 1209, 1210, 1131, 1123, 1125, 1126, 1097, 1089, 1091, 1092, 1016, 1004, 1005)
RowsToCopyEvenPath = Array(709, 708, 1259, 1262, 960, 950, 694, 765, 799, 827, 855, 869, 883, 911, 703, 695, 392, 393, 828, 525, 526, 884, 581, 582, 808, 800, 497, 498, 774, 766, 463, 464, 693, 681, 682, 1296, 1367, 1401, 1429, 1457, 1471, 1485, 1513, 1305, 1297, 1020, 1021, 1430, 1153, 1154, 1486, 1209, 1210, 1410, 1402, 1125, 1126, 1376, 1368, 1091, 1092, 1295, 1283, 1284)

'Sets the worksheets containing the data as ws1 and ws2
Set ws1 = Sheets("Main_sheet")
Set ws2 = Sheets("sub_data")

'speed (Turns off screen redraw in order to speed up script
Application.ScreenUpdating = False

'Get last row of data Sheet1, Col G
lastRow = ws1.Range("G65536").End(xlUp).Row

'Clear old data?
'Columns C to I
'<delete this to enable - ws1.Range(Cells(1, 3), Cells(lastRow + 1, 9)).Clear

'Headers (even numbered rows)
For i = 2 To lastRow + 1 Step 2
ws1.Cells(i, 7).Clear
Next i

With ws2

'Do all (odd numbers only)
For i = 1 To lastRow Step 2

mValue = ws1.Cells(i, 2)
lookFor = ws1.Cells(i, 7)
'This is then passed to the Select Case mValue function

'Allow not found error
On Error Resume Next

'Search for value in sheet 2, returning Column number if found
foundCol = .Range("H1:IV1").Find(What:=lookFor, After:=Range("H1"), LookIn:=xlFormulas, LookAt _
:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False).Column

'Check for "not found" error
If Err = 0 Then 'Was found
'==================================================================
'Check "M path" value, and carry out relevant 'case'
Select Case mValue
Case Is = "M1", "M3"
'Copy header - Not requested in post but is in "examplesheet3")
ws1.Cells(i + 1, 7) = lookFor

If foundCol > 0 Then
nextCol = 7
For j = 1 To ws2.Cells(1, foundCol).End(xlDown).Row
If Not IsError(Application.Match(j, RowsToCopyOddPath, 0)) Then
nextCol = nextCol + 1
ws2.Cells(j, foundCol).Copy ws1.Cells(i + 1, nextCol)

End If
Next j
End If
Case Is = "M2", "M4"
'Copy header - Not requested in post but is in "examplesheet3")
ws1.Cells(i + 1, 7) = lookFor

If foundCol > 0 Then
nextCol = 7
For j = 1 To ws2.Cells(1, foundCol).End(xlDown).Row
If Not IsError(Application.Match(j, RowsToCopyEvenPath, 0)) Then
nextCol = nextCol + 1
ws2.Cells(j, foundCol).Copy ws1.Cells(i + 1, nextCol)

End If
Next j
End If

End Select
'====================================================================
Else
'reset for next test
Err.Clear
End If
Next i

End With



'Reset and cleanup
With Application
.ScreenUpdating = True
.CutCopyMode = False
End With
Set ws1 = Nothing
Set ws2 = Nothing

End Sub[/vba]

Many many thanks!

Chris

[cchris_uk]

I was trying to explain this problem to a friend, and it dawned on me that I am attempting to overcomplicate the situation!

I have been trying to use an array and the case loops to search down a column for data in cells, and then copy this to another sheet.

I already know what rows the data is in, as specified in the array!

So all I really needed to do, was confirm which column contained the data, and then extract the known rows in that column dependant on the states defined in mValue.

I don't have access to excel until tomorrow morning to test any ideas, so could anyone suggest the changes required in the last script to copy the rows listed in the array, in the listed order?

Should I try and create one long string with which to copy, or should I sequentially extract each cell and copy one at a time?

Chris