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