'Complicated' lookup macro - help?

TravisB81

New Member
Joined
Apr 12, 2011
Messages
12
Good day everyone :)

I have been working with excel for a long time, but I am fairly new to making clean, good macros. The macro I am trying to make right now needs to be usable by multiple people whom have varying skill levels with excel, which is making this more difficult for me.

Here is what I need the macro to do.

I want to combine multiple excel files into a spreadsheet on sheet 2 and then use a lookup to get values from sheet 2 and put them on sheet 1. The problem is that I cannot use a simple vlookup because I need to look up based on 2 values.

Right now I have a macro that is combining multiple excel files into a single sheet and then deleting any blank rows.

Here is the macro:
Code:
Private Declare Function SetCurrentDirectoryA Lib _
"kernel32" (ByVal lpPathName As String) As Long
Sub ChDirNet(szPath As String)
SetCurrentDirectoryA szPath
End Sub
Sub Combine_Workbooks_Select_Files()
Dim MyPath As String
Dim SourceRcount As Long, Fnum As Long
Dim mybook As Workbook, BaseWks As Worksheet
Dim sourceRange As Range, destrange As Range
Dim rnum As Long, CalcMode As Long
Dim SaveDriveDir As String
Dim FName As Variant
With Application
CalcMode = .Calculation
.Calculation = xlCalculationManual
.ScreenUpdating = False
.EnableEvents = False
End With
SaveDriveDir = CurDir
ChDirNet "C:\Libraries\Documents"
FName = Application.GetOpenFilename(filefilter:="Excel Files (*.xl*), *.xl*", _
MultiSelect:=True)
If IsArray(FName) Then
Set BaseWks = Workbooks.Add(xlWBATWorksheet).Worksheets(1)
rnum = 1
For Fnum = LBound(FName) To UBound(FName)
Set mybook = Nothing
On Error Resume Next
Set mybook = Workbooks.Open(FName(Fnum))
On Error GoTo 0
If Not mybook Is Nothing Then
On Error Resume Next
With mybook.Worksheets(1)
Set sourceRange = .Range("A2:Q100")
End With
If Err.Number > 0 Then
Err.Clear
Set sourceRange = Nothing
Else
If sourceRange.Columns.Count >= BaseWks.Columns.Count Then
Set sourceRange = Nothing
End If
End If
On Error GoTo 0
If Not sourceRange Is Nothing Then
SourceRcount = sourceRange.Rows.Count
If rnum + SourceRcount >= BaseWks.Rows.Count Then
MsgBox "Not enough rows in the sheet. "
BaseWks.Columns.AutoFit
mybook.Close savechanges:=False
GoTo ExitTheSub
Else
Set destrange = BaseWks.Range("A" & rnum)
With sourceRange
Set destrange = destrange. _
Resize(.Rows.Count, .Columns.Count)
End With
destrange.Value = sourceRange.Value
rnum = rnum + SourceRcount
End If
End If
mybook.Close savechanges:=False
End If
Next Fnum
BaseWks.Columns.AutoFit
End If
ExitTheSub: 
With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = CalcMode
End With
ChDirNet SaveDriveDir
Columns(1).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End Sub

I realize this macro uses sheet 1 and needs to be altered some to use sheet 2. I also realize that the current macro only looks for the first 100 rows to compile, I don't know how to make it look for all the information regardless of how many rows it may be.

I am learning by doing :)

So the table on sheet 1 has 17 columns and a varying number of rows, the files I am combining for sheet 2 will only have 15 columns, but also have varying number of rows.

Once the files are compiled onto sheet 2 I want to look up based on values in Column B (warehouse) and column F (item number). I can't just look up by item number because the item numbers exist in multiple warehouses. Once I have looked up the correct row using Col B and F, I want to take the information from Column N and Column O on sheet 2 (the compiled list) and put it into the same columns on sheet 1.

Once I have all of the values from sheet 2 on sheet 1, I don't need to use sheet 2 anymore, but I do need to do some additional formatting to sheet 1, which I know can be macro'd into the end of the lookup macro.

The formatting section:

I need to check the value in column N compare it to column L to test if the values are equal and if they are NOT equal to format the cell in column N to be filled green. If column L is blank, compare it to column K, and if column K is also blank compare it to column J, but to not compare all 3... only go to the next cell if the first check and/or second check are blank.

Then if the values are not equal (thus making the cell green) I need the macro to to put a "Y" in column P if the value in N is green because it is LESS THAN the checked cells.

There is one last thing I'd like to add to the macro, but I'm not sure if it's possible. Column O is a comments column. I'd like the macro to add the current date to the end of any cell that is not blank. So if the cell is blank it would enter nothing, but if the cell says "Lack of materials" or anything else I'd like it to alter the cell to say "Lack of Materials 5/28/12" or whatever happens to be the current date.

As I mentioned before the most difficult thing for me is to make this macro usable by several people of varying skills with excel. I need to make it a template so people can put their list in to sheet 1 and then run the macro, tell it which files to compile, and then the macro do the rest of the work for them, without them having to change variables or tinker with the macro (which is what I would normally do if something went wrong).

I appreciate any advice you can give me, I'm trying hard to learn as much as I can about VBA and macros in excel so that I can make more macros in the future that are usable by anyone.

Thank you very much!!!
 
Last edited:

Excel Facts

Waterfall charts in Excel?
Office 365 customers have access to Waterfall charts since late 2016. They were added to Excel 2019.

Forum statistics

Threads
1,214,525
Messages
6,120,051
Members
448,940
Latest member
mdusw

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top