alternative to VLOOKUP for large range

[NewUser]

I've used the forums often for the last few weeks while working on my Excel VBA project - thanks to all who've posted in the past! Now, I've run up against an issue that I haven't found the solution for and hoping you can help... : pray2:

So far, I've built a macro in a workbook that send emails to employees asking for preferences/availability for a future work schedule schedule. Another macro imports each employee's preferences for the upcoming quarter. I've used data validation to ensure responses from employees are uniform. A future step is to run Excel Solver to optimize the work schedule while maximizing employee preferences. To do that though, I need to translate my sheet of employee preferences (i.e. "Unavailable", "1st Choice", "2nd Choice", "3rd Choice", or [BLANK/available]) for each week into a numeric value (i.e. 1000000, 0, 250, 500, or 5000, respectively). The number of employees changes quarter to quarter (I've been using "xlUP" to find the total number of dynamic rows) but the number of weeks per quarter is always 13 (columns E to Q).

In short, I'd like to translate the employee preferences in Sheets("Preferences").Range("E3:Q" & rowcount) from words like "Unavailable" or "2nd Choice" into Sheets("Calculations").Range("E3:Q" & rowcount) with numbers like 1000000 and 250, for example. I had planned to look up the corresponding values in a table Sheets("Definitions").Range("B3:C7").

I've thought about using VLOOKUP and loop/do until cell by cell, row by row for the entire range but guess that will be slow and inefficient. I've searched (probably not using the correct terms :banghead:) and can't find a way to utilize VLOOKUP for an whole horizontal range/row for the entire range in a sheet.

Any suggestions? I did not provide code because I literally have nothing relevant to this post; solution code would be welcome, of course, but I'm probably just looking for someone to point me in the right direction of how to solve this problem.

Thanks in advance!

[mdmackillop]

Can you post a sample workbook showing what you are after Go Advanced / Manage Attachments.
Are the cell in both sheets to be linked by formula or can it be copied to the second sheet with the new values as constants?
Approx how many rows?

[Paul_Hossler]

For just a few choices, I'd just use VBA .Replace




Option Explicit
Sub Translate()

Application.ScreenUpdating = False

On Error Resume Next
Application.DisplayAlerts = False
Worksheets("Calculations").Delete
Application.DisplayAlerts = True
On Error GoTo 0

Worksheets("Preferences").Copy After:=Worksheets("Preferences")
ActiveSheet.Name = "Calculations"

With Range(Range("E3"), Range("Q" & Rows.Count).End(xlUp))
Call .Replace("Unavailable", 1000000, , , False)
Call .Replace("1st Choice", 0, , , False)
Call .Replace("2nd Choice", 250, , , False)
Call .Replace("3rd Choice", 500, , , False)
On Error Resume Next
.SpecialCells(xlCellTypeBlanks).Value = 5000
On Error GoTo 0
End With

Application.ScreenUpdating = True

End Sub

[NewUser]

Example workbook attached. The "Preferences" sheet will be populated after importing each employees' preferences from workbooks they return to me. The "Definitions" sheet may not be necessary if VLOOKUP isn't used. The bottom of the "Calculations" sheet is where I'm trying to populate the translated preferences. (The top of the sheet will eventually be the binary optimized scheduling solution from Solver.)

Number of rows will vary but should stay between 50-100 total. (Current row count is 88.)

Thanks!

[mdmackillop]

It would appear that a better solution would be to import directly from the returned workbooks to both sheets.

[Paul_Hossler]

Option Explicit

Sub Translate_Try2()
Dim r As Range

Application.ScreenUpdating = False

Worksheets("Preferences").Range("A2").CurrentRegion.Copy Worksheets("Calculations (Hidden)").Range("A6")

With Worksheets("Calculations (Hidden)")
Set r = Intersect(.Range("A6").CurrentRegion, .Range("C:Q"))
End With

With r
Call .Replace("Unavailable", 1000000, , , False)
Call .Replace("1st Choice", 0, , , False)
Call .Replace("2nd Choice", 250, , , False)
Call .Replace("3rd Choice", 500, , , False)
On Error Resume Next
.SpecialCells(xlCellTypeBlanks).Value = 5000
On Error GoTo 0
End With

Application.ScreenUpdating = True

End Sub