Macro to cross reference Workbooks

Closed
Hotbunnycharlie - Jun 7, 2012 at 11:52 AM
venkat1926 Posts 1863 Registration date Sunday June 14, 2009 Status Contributor Last seen August 7, 2021 - Jun 8, 2012 at 01:17 AM
Hi all,

I am (VERY) new to macros, and I am trying to create one that searches the cell in Column D in workbook 2, cross references it by the same column in workbook 1 and then copies the text from Column L in workbook 1 to column N in workbook 2.

I have the below formula, but I can't get it to work, it just keeps saying "you selected the wrong file".

Can anyone see anything obvious in the code that would stop it working? (It was written for a similar task, but on excel 2003 and so I'm not sure if that's what the core issue is.) Sorry for being such a novice, if you could help I would really appreciate it.


Sub Tracker()
Dim wbname As String ' name of the active workbook
Dim wbActive As Workbook ' active workbook
Dim prvFilePath As String
Dim prvFileName As String
Dim rnglookup As Range
Dim rngsearch As Range
Dim wsResp As Worksheet
Dim wsPrevResp As Worksheet

screenUpdateState = Application.ScreenUpdating
statusBarState = Application.DisplayStatusBar
calcState = Application.Calculation
eventsState = Application.EnableEvents
displayPageBreakState = ActiveSheet.DisplayPageBreaks 'note this is a sheet-level setting

'turn off some Excel functionality so code runs faster
Application.ScreenUpdating = False
Application.DisplayStatusBar = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False
ActiveSheet.DisplayPageBreaks = False

' defining the variable for the active workbook
wbname = ActiveWorkbook.Name
Set wbActive = Workbooks(wbname)

' select the previous report from a dialog box
prvFilePath = Application.GetOpenFilename(filefilter:="Excel File (*.xlsm), *.xlsm", Title:="select the previous report")
Select Case prvFilePath
Case False
MsgBox "You did not select a file. The macro will stop."
Exit Sub
Case Else
Do Until LCase(prvFilePath) Like "*Cascade*"
x = MsgBox("you selected the wrong file", vbRetryCancel)
If x = vbCancel Then
MsgBox "You cancelled the action. The macro will stop."
Exit Sub
Else: prvFilePath = Application.GetOpenFilename(filefilter:="Excel File (*.xlsm), *.xlsm", Title:="select the previous report")
End If
Loop
End Select

Workbooks.Open prvFilePath
prvFileName = Mid(prvFilePath, InStrRev(prvFilePath, "\") + 1)
Workbooks(prvFileName).Worksheets("AM Tracker").AutoFilterMode = False

Set wsResp = Workbooks(wbname).Worksheets("AM Tracker")
Set wsPrevResp = Workbooks(prvFileName).Worksheets("AM Tracker")

Set rnglookup = Intersect(wsResp.Range("T1").CurrentRegion, wsResp.Range("T1").CurrentRegion.Offset(1))
Set rnglookup = col(rnglookup, "L")
Set rngsearch = Intersect(wsPrevResp.Range("T1").CurrentRegion, wsPrevResp.Range("T1").CurrentRegion.Offset(1))
Set rngsearch = col(rngsearch, "N")

lastrow = wsResp.Cells.Find(what:="*", searchorder:=xlByRows, searchdirection:=xlPrevious).Row

With wsResp
.Range("z2:z" & lastrow) = getcomment(rnglookup, rngsearch, 6)
End With

Workbooks(prvFileName).Close savechanges:=False

Application.ScreenUpdating = screenUpdateState
Application.DisplayStatusBar = statusBarState
Application.Calculation = calcState
Application.EnableEvents = eventsState
ActiveSheet.DisplayPageBreaks = displayPageBreaksState
End Sub
Function col(rng As Range, colname As String) As Range
Set col = Intersect(rng, rng.Columns(colname))
End Function
Function getcomment(rnglookup As Range, rngsearch As Range, icol As Integer) As Variant
Dim r As Range
Dim rfind As Range
ReDim result(1 To rnglookup.Count, 0) As Variant

i = 1
For Each r In rnglookup
Set rfind = rngsearch.Find(what:=r.Value, LookIn:=xlValues, lookat:=xlWhole, searchorder:=xlByRows, searchdirection:=xlNext)
If Not rfind Is Nothing Then
result(i, 0) = rfind.Offset(0, icol)
End If
i = i + 1
Next r
getcomment = result
End Function





1 response

venkat1926 Posts 1863 Registration date Sunday June 14, 2009 Status Contributor Last seen August 7, 2021 811
Jun 8, 2012 at 01:17 AM
PERHAPS there is no need for such a long macro with many function. I suggest you send the two workbooks only necessary sheet through speedyshar.com
and then explain with these two workbooks what you want
0