Find Emp Name and Random assigining of Audit reports

[SYEDZAHED]

In Sheet1 I have audit reports.
In sheet2 I have EMP Names and number of audit to be allot.
In sheet3 the audit report numbers to be pasted under each EMP Name randomly picking from sheet1.

It is like, the macro should got to sheet3 first and take one emp name, search the emp name in sheet2 and check how many audits to be allotted to that emp then go to sheet1 copy the audit number and at the same time it should written next to audit number column "Assigned".

Can anyone please help me by solving the problem using VBA. I am attaching the excel sheet for reference.

 

[vletm]

SYEDZAHED
Press Sheet3's [ Do It ]-button ...

 

[shrivallabha]

Welcome to Chandoo Org forums!

Following code shall work for you with the sample workbook. I have tried (mostly) to comment through code so that you can adjust them to suit.

Public Sub AssignAuditReports()

'\\ Assign sheet names here if they differ in the actual setup
Dim ShtAudit As Worksheet: Set ShtAudit = Sheets("Sheet1")
Dim ShtCount As Worksheet: Set ShtCount = Sheets("Sheet2")
Dim shtAsign As Worksheet: Set shtAsign = Sheets("Sheet3")

'\\ Define Range Header to loop through. Set it to suit if this is different
Dim rngNameHdr As Range: Set rngNameHdr = shtAsign.Range(shtAsign.Cells(1, 1), shtAsign.Cells(1, shtAsign.Columns.Count).End(xlToLeft))
rngNameHdr.CurrentRegion.Offset(1, 0).Delete xlUp

Dim rngCurrent As Range
Dim rngRgCount As Range
Dim i As Long, lngCnt As Long, lngLastRow As Long

'\\Change to suit to match the Sheet1 claim audit number start row & end row
lngCnt = 2
lngLastRow = ShtAudit.Range("A" & ShtAudit.Rows.Count).End(xlUp).Row
ShtAudit.Range("B" & lngCnt & ":B" & lngLastRow).ClearContents

'\\ Loop through the data in Sheet3
For Each rngCurrent In rngNameHdr
    '\\ See if we can locate data in column A on sheet 2
    Set rngRgCount = ShtCount.Range("A:A").Find(rngCurrent.Value, , , xlWhole)
    If Not rngRgCount Is Nothing Then
        For i = 1 To rngRgCount.Offset(0, 1).Value '\\ Set offset to suit on sheet2
            If lngCnt <= lngLastRow Then
                rngCurrent.Offset(i, 0).Value = ShtAudit.Range("A" & lngCnt).Value
                ShtAudit.Range("B" & lngCnt).Value = "Assigned"
                lngCnt = lngCnt + 1
            Else
                '\\ Since we have run out of audit numbers we inform for the rest of the names!
                rngCurrent.Offset(i, 0).Value = "Assigning audit finished!"
                Exit For
            End If
        Next i
    Else
        '\\ If we can't find we report
        rngCurrent.Offset(1, 0).Value = "Name not listed in Count Sheet!"
    End If
Next

End Sub

 

[SYEDZAHED]

Thanks Shrivallabha, Its working great