VBA Lookup?

[plasteredric]

Hi All,

Trying to figure of the code for this, but failing miserably.

I have multiple sheets, each one will compile data daily from a single sheet ("Import")

In the daily sheets there are a list of names in column B, I want a macro to lookup those names against column D in the Import Sheet, and return that persons score found in column Y into column H of the daily sheet.

Hope that makes sense

[offthelip]

try this:


Sub test()Dim outarr() As Variant


With Sheets("Import")
lastrow = .Cells(Rows.Count, "D").End(xlUp).Row
Import = Range(.Cells(1, 1), .Cells(lastrow, 25))
End With
With Sheets("Daily")
lastnam = .Cells(Rows.Count, "B").End(xlUp).Row
Namearr = Range(.Cells(1, 2), .Cells(lastnam, 2))


ReDim outarr(1 To lastnam, 1 To 1)
For i = 1 To lastnam
For j = 1 To lastrow
If Namearr(i, 1) = Import(j, 4) Then
outarr(i, 1) = Import(j, 25)
Exit For
End If
Next j
Next i


Range(.Cells(1, 8), .Cells(lastnam, 8)) = outarr
End With


End Sub

[plasteredric]

I can't seem to get that to work, I've had to rejig the layout of the sheets as well.
Also, the name of the destination sheet will change so I've put in the following code to deal with that.


Dim sStartSheet As String
sStartSheet = ActiveSheet.Name




The destination sheet has the Names to lookup in cells E18:E1000 and I need the result to be put into the same rows in column G.

The source sheet (RTR_Import) contains the names in cells CI6:CI1000 and the data to be returned in CK6:CK1000

Thanks in advance

[offthelip]

not tested but try this:


Sub test()Dim outarr() As Variant
Dim sStartSheet As String
sStartSheet = ActiveSheet.Name

With Sheets("RTR_Import")
lastrow = .Cells(Rows.Count, "CI").End(xlUp).Row
Import = Range(.Cells(1, 1), .Cells(lastrow, 89))
End With
With activeSheet
lastnam = .Cells(Rows.Count, "E").End(xlUp).Row
Namearr = Range(.Cells(1, 5), .Cells(lastnam, 5))


ReDim outarr(1 To lastnam, 1 To 1)
For i = 1 To lastnam
For j = 1 To lastrow
If Namearr(i, 1) = Import(j, 87) Then
outarr(i, 1) = Import(j, 89)
Exit For
End If
Next j
Next i


Range(.Cells(1, 7), .Cells(lastnam, 7)) = outarr
End With


End Sub

[plasteredric]

Thank you for your help.

That partially worked, it pulls the correct data through, but I seems to be doing it for the full column as I think it tries to lookup the column header as well. Wish I could fathom that code you've done, it's completely beyond me.

[offthelip]

I have annotated the code with what each line does:


Sub test() Dim outarr() As Variant ' this just defines an array of variants.
' This so that i can wrtie it back to the worksheet
Dim sStartSheet As String
sStartSheet = ActiveSheet.Name ' this is your code to save the active sheet name
' Not necessary any more
With Sheets("RTR_Import") ' this says that the following code is excecute on the RTR_Import sheet
lastrow = .Cells(Rows.Count, "CI").End(xlUp).Row ' this finds the last cell with data in it on column "CI"
Import = Range(.Cells(1, 1), .Cells(lastrow, 89)) ' this copies all of the data (columns 1 to column 89 [CK]) from the RTR_Import sheet to the array "Import"
End With ' this says that the code "with " RTR_Import sheet ends here
With ActiveSheet ' this says do everything on the active sheet from here on
lastnam = .Cells(Rows.Count, "E").End(xlUp).Row ' This finds the last cell with data in it in column E of the active sheet
Namearr = Range(.Cells(1, 5), .Cells(lastnam, 5)) ' This loads all of the data in column 5 ( E) on the active sheet in the arry Namearr
' the reason for loading all the data into variant arrays is thatit is much much faster to do this instead of operating
' directly on the cells in a work sheet. I did a test what took 18 secs operating on the cells took 0.34 seconds
' using this technique


ReDim outarr(1 To lastnam, 1 To 1) ' the redimensions the output array to the correct size , now that we know how many lines we have got

For i = 1 To lastnam ' this controls the loop through all the names in Namearr (col E active sheet)
For j = 1 To lastrow ' this control the loop through the data in Import ( RTR_ Import )
If Namearr(i, 1) = Import(j, 87) Then ' this compares the data in column E of active sheet with data in column 87 (CI) of RTR_import '
' Namearr is Col E active sheet, Import is all the data from RTR_Import
outarr(i, 1) = Import(j, 89) ' a match is found so copy the data from column 89 of the RTR_Import sheet to the output array on the same line as the Active sheet (i)

Exit For
End If
Next j
Next i


Range(.Cells(1, 7), .Cells(lastnam, 7)) = outarr ' write the output data to the active sheet in column 7 (G)

End With


End Sub


Secondly if you want it to start the match on row two, all you havle to do is change where the loop controls start, so instead of


For i = 1 To lastnam
For j = 1 To lastrow




change this to:


For i = 2 To lastnam
For j = 2 To lastrow

[plasteredric]

Cheers, appreciate your help.

From what you've wrote, Im guessing the macro loads everything into some sort of "virtual" table then outputs the data into the sheet.

'For i = 1 To lastnam / For j = 1 To lastrow'.
I figure the 'for i' relates to the start row of the names list and the 'for j' the start row on the RTR_IMPORT sheet.
I've had a play around, the start cell in the Names list is 'E18' and the start row of the data to search on the RTR_IMPORT sheet is 6 so i've changed the code to:

For i = 18 To lastnam
For j = 6 To lastrow
The problem I'm having is that it keep clearing the header cell in the destination range (cell G17)

Do you have any ideas why it keeps doing that?

[offthelip]

Yes it is because the statement:


Range(.Cells(1, 7), .Cells(lastnam, 7)) = outarr
overwrites it.
This statement says write the contents of the array "outarr" in to the range as defined from Cell row 1 column 7 to cell row "lastnam" column 7.
I.E G1 to g what ever the last row is.
So to avoid overwriting the header row change it to :


Range(.Cells(2, 7), .Cells(lastnam+1, 7)) = outarr
However obviously this is going to move all the output down one row, so to adjust for this you must also change the index where you write the data into the array; this means changing


outarr(i, 1) = Import(j, 89)
to

outarr(i-1, 1) = Import(j, 89)

This will work provided you have changed the loop to start with an index of at least 2 as in my post #6. I notice that you are now starting at row 18 so this will be fine.

[plasteredric]

It's still changing the header cell. Here's the code that ive used if you can see any mistakes.

Sub GET_RTR_RESULTS()
Dim outarr() As Variant ' this just defines an array of variants.
' This so that it can write it back to the worksheet
With Sheets("RTR_Import") ' this says that the following code is excecute on the RTR_Import sheet
lastrow = .Cells(Rows.Count, "CI").End(xlUp).Row ' this finds the last cell with data in it on column "CI"
Import = Range(.Cells(1, 1), .Cells(lastrow, 89)) ' this copies all of the data (columns 1 to column 89 [CK]) from the RTR_Import sheet to the array "Import"
End With ' this says that the code "with " RTR_Import sheet ends here
With ActiveSheet ' this says do everything on the active sheet from here on
lastnam = .Cells(Rows.Count, "E").End(xlUp).Row ' This finds the last cell with data in it in column E of the active sheet
Namearr = Range(.Cells(1, 5), .Cells(lastnam, 5)) ' This loads all of the data in column 5 ( E) on the active sheet in the arry Namearr
' the reason for loading all the data into variant arrays is thatit is much much faster to do this instead of operating
' directly on the cells in a work sheet. I did a test what took 18 secs operating on the cells took 0.34 seconds
' using this technique


ReDim outarr(1 To lastnam, 1 To 1) ' the redimensions the output array to the correct size , now that we know how many lines we have got

For i = 2 To lastnam ' this controls the loop through all the names in Namearr (col E active sheet)
For j = 2 To lastrow ' this control the loop through the data in Import ( RTR_ Import )
If Namearr(i, 1) = Import(j, 87) Then ' this compares the data in column E of active sheet with data in column 87 (CI) of RTR_import '
' Namearr is Col E active sheet, Import is all the data from RTR_Import
outarr(i - 1, 1) = Import(j, 89) ' a match is found so copy the data from column 89 of the RTR_Import sheet to the output array on the same line as the Active sheet (i)

Exit For
End If
Next j
Next i


Range(.Cells(2, 7), .Cells(lastnam + 1, 7)) = outarr ' write the output data to the active sheet in column 7 (G)

End With


End Sub

[offthelip]

I misread your post, I made the assumption that your header was in row 1 it would appear that it is in row 17, so you apply the same idea
write the data out from row 18 onwards:



Range(.Cells(18, 7), .Cells(lastnam + 18, 7)) = outarr


and write the array offset by the same amount:



outarr(i - 17, 1) = Import(j, 89)

You could tidy it up by declaring outarr to be the right size by changing


ReDim outarr(1 To lastnam, 1 To 1)

to


ReDim outarr(1 To lastnam-17, 1 To 1)

in which case


Range(.Cells(18, 7), .Cells(lastnam + 18, 7)) = outarr

should be


Range(.Cells(18, 7), .Cells(lastnam , 7)) = outarr

[mdmackillop]

Hi Plasteredric

I made the assumption that your header was in row 1 it would appear that it is in row 17
It's always best to post a workbook with your actual data layout and realistic data (Go Advanced / Manage Attachments) to avoid such issues.

[plasteredric]

Thanks pal, sorted it. works a treat now.


Sub GET_RTR_RESULTS()
Dim outarr() As Variant ' this just defines an array of variants.
' This so that it can write it back to the worksheet
With Sheets("RTR_Import") ' this says that the following code is excecute on the RTR_Import sheet
lastrow = .Cells(Rows.Count, "CI").End(xlUp).Row ' this finds the last cell with data in it on column "CI"
Import = Range(.Cells(1, 1), .Cells(lastrow, 89)) ' this copies all of the data (columns 1 to column 89 [CK]) from the RTR_Import sheet to the array "Import"
End With ' this says that the code "with " RTR_Import sheet ends here
With ActiveSheet ' this says do everything on the active sheet from here on
lastnam = .Cells(Rows.Count, "E").End(xlUp).Row ' This finds the last cell with data in it in column E of the active sheet
Namearr = Range(.Cells(1, 5), .Cells(lastnam, 5)) ' This loads all of the data in column 5 ( E) on the active sheet in the arry Namearr
' the reason for loading all the data into variant arrays is thatit is much much faster to do this instead of operating
' directly on the cells in a work sheet. I did a test what took 18 secs operating on the cells took 0.34 seconds
' using this technique


ReDim outarr(1 To lastnam - 17, 1 To 1) ' the redimensions the output array to the correct size , now that we know how many lines we have got

For i = 18 To lastnam ' this controls the loop through all the names in Namearr (col E active sheet)
For j = 6 To lastrow ' this control the loop through the data in Import ( RTR_ Import )
If Namearr(i, 1) = Import(j, 87) Then ' this compares the data in column E of active sheet with data in column 87 (CI) of RTR_import '
' Namearr is Col E active sheet, Import is all the data from RTR_Import
outarr(i - 17, 1) = Import(j, 89) ' a match is found so copy the data from column 89 of the RTR_Import sheet to the output array on the same line as the Active sheet (i)

Exit For
End If
Next j
Next i


Range(.Cells(18, 7), .Cells(lastnam, 7)) = outarr ' write the output data to the active sheet in column 7 (G)

End With


End Sub




That's the code I ended with.

Thanks again.

[plasteredric]

Further to the above, how would I go about getting additional columns across?
If possible I would also like to return column 65 (BM) from the RTR_IMPORT sheet into column 8 (G) on the destination sheet.

Cheers

[plasteredric]

I think I've figured it out, can anyone see any issues with the code below?



Sub GET_RTR_RESULTS()
Dim outarr() As Variant ' this just defines an array of variants.
Dim outarr1() As Variant ' this just defines an array of variants.
' This so that it can write it back to the worksheet
With Sheets("RTR_Import") ' this says that the following code is excecute on the RTR_Import sheet
lastrow = .Cells(Rows.Count, "CI").End(xlUp).Row ' this finds the last cell with data in it on column "CI"
Import = Range(.Cells(1, 1), .Cells(lastrow, 89)) ' this copies all of the data (columns 1 to column 89 [CK]) from the RTR_Import sheet to the array "Import"
End With ' this says that the code "with " RTR_Import sheet ends here
With ActiveSheet ' this says do everything on the active sheet from here on
lastnam = .Cells(Rows.Count, "E").End(xlUp).Row ' This finds the last cell with data in it in column E of the active sheet
Namearr = Range(.Cells(1, 5), .Cells(lastnam, 5)) ' This loads all of the data in column 5 ( E) on the active sheet in the arry Namearr
' the reason for loading all the data into variant arrays is thatit is much much faster to do this instead of operating
' directly on the cells in a work sheet. I did a test what took 18 secs operating on the cells took 0.34 seconds
' using this technique


ReDim outarr(1 To lastnam - 17, 1 To 1) ' the redimensions the output array to the correct size , now that we know how many lines we have got
ReDim outarr1(1 To lastnam - 17, 1 To 1) ' the redimensions the output array to the correct size , now that we know how many lines we have got

For i = 18 To lastnam ' this controls the loop through all the names in Namearr (col E active sheet)
For j = 6 To lastrow ' this control the loop through the data in Import ( RTR_ Import )
If Namearr(i, 1) = Import(j, 87) Then ' this compares the data in column E of active sheet with data in column 87 (CI) of RTR_import '
' Namearr is Col E active sheet, Import is all the data from RTR_Import
outarr(i - 17, 1) = Import(j, 89) ' a match is found so copy the data from column 89 of the RTR_Import sheet to the output array on the same line as the Active sheet (i)
outarr1(i - 17, 1) = Import(j, 65) ' a match is found so copy the data from column 89 of the RTR_Import sheet to the output array on the same line as the Active sheet (i)

Exit For
End If
Next j
Next i

Range(.Cells(18, 7), .Cells(lastnam, 7)) = outarr ' write the output data to the active sheet in column 7 (G)
Range(.Cells(18, 8), .Cells(lastnam, 8)) = outarr1 ' write the output data to the active sheet in column 7 (G)

End With

End Sub