![]()
Sub doyoc() Dim ws1 As Worksheet: Set ws1 = Sheets("RoomTracker") Dim ws2 As Worksheet: Set ws2 = Sheets("SA021") Dim rFind As Range, c As Range, rng As Range, numFind As Range Dim strErr As String Application.ScreenUpdating = False Set rFind = ws1.Rows(4).Find(WorksheetFunction.WeekNum(Date, 1), , xlValues, xlWhole).Offset(, -2) Set rng = ws1.Range("A5:A" & ws1.Range("A" & Rows.Count).End(xlUp).Row) strErr = vbNullString If Not rFind Is Nothing Then For Each c In rng If IsNumeric(c) And Len(c) = 8 Then Set numFind = ws2.Range("B2:B" & ws2.Range("B" & Rows.Count).End(xlUp).Row).Find(c, , xlValues, xlWhole) If Not numFind Is Nothing Then ws1.Cells(c.Row, rFind.Column) = ws2.Range("P" & numFind.Row) Else strErr = strErr & Chr(10) & c End If End If Next c Else MsgBox ("Error. Could not find week.") End If If Not strErr = vbNullString Then MsgBox ("The following numbers could not be found:" & strErr) End If Application.ScreenUpdating = True End Sub
Bookmarks