Macro to assign cases based on numbers mentioned in cell

[Gaurangg]

Hi,

I need some help in assigning data to the employees from two different worksheets. I have a excel file with 4 worksheets.

1st Sheet = "Process1", 2nd Sheet = "Process2", 3rd Sheet = EMPList and 4th = Assigned_Tasks

I have different data in process1 and Process2. Where I have Employee data with the numbers of cases to be assigned as per column F and Column G. i.e. EmpID 13647 should be assgined 3 cases from Process1 and 1 case from Process2 worksheets. And these 4 cases should also be updated in Assigned task sheet and emailed to him. This macro should work until last employee.

Also Employee and cases should be filtered as Pending from the status field.

Kindly help with the code.

 

[Gaurangg]

I have worked on below code for selecting Pending case data from Process1 sheet, But could not select the number of rows based on cell value of F2 in EmpList sheet.


Sub CopyRows()

Dim rng As Range
Dim r As Range
Dim n1, n2 As Integer
Dim n As Integer
Dim i As Long

new1 = Sheets("EmpList").Range("F2").Value
new2 = Sheets("EmpList").Range("G2").Value

With Sheets("Process1")
'Dim MRng As Range
On Error Resume Next
Sheets(1).ShowAllData
On Error GoTo 0

If new1 > 0 Then
Sheets("Process1").Activate
Range("A1:D1").AutoFilter
MRng = Sheet1.Range("A1048576").End(xlUp).Row

Range("C1").Select
Range("$A$1:$D" & MRng).AutoFilter Field:=4, Criteria1:="Pending"
Range("$A$1:$D" & MRng).Select

ActiveCell.Offset(1, 0).Select
Do Until ActiveCell.EntireRow.Hidden = False
ActiveCell.Offset(1, 0).Select
Loop

Range("A2:D", new1).Select ' Here I am getting error. Want to select the range from active cell till the number of rows mentioned in the cell value of F2 in EmpList sheet.

End If
End With

End Sub

 

[Gaurangg]

I googled and found below code to copy number of rows based on cell value. I haven't tried, however in this code, the cell value in the same worksheet whereas my cell value in different worksheet. Can anyone please help to modify the code for me?

Sub CopyData()
Dim rngSinglecell As Range
Dim rngQuantityCells As Range
Dim intCount As Integer
Dim ws1 As Worksheet
Dim name_ws As String
Dim lastRow As Long, lastRow2 As Long

name_ws = "Sheet1" '<--- put name of your main worksheet

Set ws1 = ThisWorkbook.Sheets(name_ws)
With ws1

lastRow = .Cells(Rows.Count, 3).End(xlUp).Row
Set rngQuantityCells = .Range("C2:C" & lastRow)

For Each rngSinglecell In rngQuantityCells
If IsNumeric(rngSinglecell.Value) Then

If rngSinglecell.Value > 0 Then
For intCount = 1 To rngSinglecell.Value
lastRow2 = ThisWorkbook.Sheets("Feuil2").Cells(Rows.Count, 3).End(xlUp).Row + 1
.Rows(rngSinglecell.Row).EntireRow.Copy ThisWorkbook.Sheets("Feuil2").Rows(lastRow2)
Next
End If

End If
Next

End With

End Sub
-----------------------Or ---------------------------------------------

Sub CopyRowsFromColumnN()

Dim rng As Range
Dim r As Range
Dim numberOfCopies As Integer
Dim n As Integer

'## Define a range to represent ALL the data
Set rng = Range("A1", Range("N1").End(xlDown))

'## Iterate each row in that data range
For Each r In rng.Rows
'## Get the number of copies specified in column 14 ("N")
numberOfCopies = r.Cells(1, 14).Value

'## If that number > 1 then make copies on a new sheet
If numberOfCopies > 1 Then
'## Add a new sheet
With Sheets.Add
'## copy the row and paste repeatedly in this loop
For n = 1 To numberOfCopies
r.Copy .Range("A" & n)
Next
End With
End If
Next

End Sub

 

[bebo021999]

Hello
1) try to wrap vba code in side the vba tag like this

This is VBA code

2) to get fast answers, try to attch a mini sheet to help helpers prevent manual input data to test.

XL2BB - Excel Range to BBCode

Excel 'mini-sheet' in messages - XL2BB Although experts prefer to read your description and question instead of working in your actual file to solve your problem, there are times that it is difficult to explain an issue without providing actual...

www.mrexcel.com

 

[Gaurangg]

Dear Sir,

Apologies for the late reply. Please find below codes wrapped as vba tag

below code which I have prepared

Sub CopyRows()

Dim rng As Range
Dim r As Range
Dim n1, n2 As Integer
Dim n As Integer
Dim i As Long

new1 = Sheets("EmpList").Range("F2").Value
new2 = Sheets("EmpList").Range("G2").Value

With Sheets("Process1")
'Dim MRng As Range
On Error Resume Next
Sheets(1).ShowAllData
On Error GoTo 0

If new1 > 0 Then
Sheets("Process1").Activate
Range("A1:D1").AutoFilter
MRng = Sheet1.Range("A1048576").End(xlUp).Row

Range("C1").Select
Range("$A$1:$D" & MRng).AutoFilter Field:=4, Criteria1:="Pending"
Range("$A$1:$D" & MRng).Select

ActiveCell.Offset(1, 0).Select
Do Until ActiveCell.EntireRow.Hidden = False
ActiveCell.Offset(1, 0).Select
Loop

Range("A2:D", new1).Select ' Here I am getting error. Want to select the range from active cell till the number of rows mentioned in the cell value of F2 in EmpList sheet.

End If
End With

End Sub[/SIZE]

What exactly I require is...

1. Filter the case data from Process1 & Process2 sheets with criteria "Pending" from column E "Case Status"
2. Check the number from i2 column in EmpList sheet and select the number of rows from Process1 sheet. Copy those rows data and paste them into Database sheet.
3. check the numner from j2 column in EmpList sheet and select the number of rows from Process2 sheet. Copy those rows data and paste them into database sheet.
4. for an example - i2 = 1 hence select one row from Process1 sheet and copy paste it into Database sheet. then j2 = 4 hence select 4 rows from Process2 sheet and copy paste them into database sheet.
5. update the Employee data from A2:H2 in all these 5 rows data in Database sheet. It seems that these cases have been assigned to this employee.
6. After this, macro should move to next employee in EmpList and copy raws from process1 & process2 sheet as per the numbers updated in i and j column.
7 Do this activity until last employee in the sheet.

Below are Excel-Mini sheet uploaded for all these 4 worksheets.

Test Allocation.xlsx
	A	B	C	D	E
1	Process Name	Case ID	Case Date	Description	Case Status
2	Process1	22701	15-09-2022	XYZ	Assigned
3	Process1	35603	15-09-2022	XYZ	Assigned
4	Process1	42179	15-09-2022	XYZ	Pending
5	Process1	34741	15-09-2022	XYZ	Pending
6	Process1	37752	15-09-2022	XYZ	Pending
7	Process1	12860	15-09-2022	XYZ	Pending
8	Process1	30574	15-09-2022	XYZ	Pending
9	Process1	25814	15-09-2022	XYZ	Pending
10	Process1	42283	15-09-2022	XYZ	Pending
11	Process1	15861	15-09-2022	XYZ	Pending
12	Process1	30249	15-09-2022	XYZ	Pending
13	Process1	10067	15-09-2022	XYZ	Pending
14	Process1	33712	15-09-2022	XYZ	Pending
15	Process1	13362	15-09-2022	XYZ	Pending
Process1

Test Allocation.xlsx
	A	B	C	D	E
1	Process Name	Case ID	Case Date	Description	Case Status
2	Process2	27580	15-09-2022	XYZ	Assigned
3	Process2	26494	15-09-2022	XYZ	Assigned
4	Process2	16121	15-09-2022	XYZ	Assigned
5	Process2	18584	15-09-2022	XYZ	Assigned
6	Process2	27793	15-09-2022	XYZ	Pending
7	Process2	49514	15-09-2022	XYZ	Pending
8	Process2	18956	15-09-2022	XYZ	Pending
9	Process2	36376	15-09-2022	XYZ	Pending
10	Process2	34704	15-09-2022	XYZ	Pending
11	Process2	22477	15-09-2022	XYZ	Pending
12	Process2	32037	15-09-2022	XYZ	Pending
13	Process2	21331	15-09-2022	XYZ	Pending
14	Process2	44906	15-09-2022	XYZ	Pending
15	Process2	36432	15-09-2022	XYZ	Pending
Process2

Test Allocation.xlsx
	A	B	C	D	E	F	G	H	I	J	K
1	Emp_ID	Emp_Name	Process_Lead	Process_Manager	Skill	Site	Location	Emp_Email	Process1	Process2	Case_Allocation_Status
2	28193	ADFKADFK	XYZ	ABC	FT	CZ	Home	adfkadfk@xyz.com	1	4	Pending
3	13650	DFAFDE	XYZ	ABC	FT	CZ	Home	dfafde@xyz.com	2	2	Pending
4	96966	ETSDAGA	XYZ	ABC	FT	CZ	Home	etsdaga@xyz.com	3	1	Pending
5	29320	CASDERAS	XYZ	ABC	FT	CZ	Home	casderas@xyz.com	6	0	Pending
6	95333	CADEDRE	XYZ	ABC	FT	CZ	Home	cadedre@xyz.com	0	3	Pending
EmpList

Test Allocation.xlsx
	A	B	C	D	E	F	G	H	I	J	K	L
1	Process Name	Case ID	Case Date	Description	Emp_ID	Emp_Name	Process_Lead	Process_Manager	Skill	Site	Location	Emp_Email
2
3
4
5
Database

 

[Gaurangg]

I could end up my code as below, but stuck at one line as getting error of
Run-time error: '1004':
Method 'Range' of object '_Global' failed

Sub CopyRows()

Dim rng As Range

Dim r As Range
Dim n1, n2 As Integer
Dim n As Integer
Dim i As Long
Dim XCell As String
Dim new1 As Integer

 new1 = Sheets("EmpList").Range("F2").Value
 new2 = Sheets("EmpList").Range("G2").Value

With Sheets("Process1")
'Dim MRng As Range
    On Error Resume Next
    Sheets("Process1").ShowAllData
    On Error GoTo 0
   
If new1 > 0 Then
Sheets("Process1").Activate
Range("A1:D1").AutoFilter
MRng = Sheet1.Range("A1048576").End(xlUp).Row

    Range("C1").Select
    Range("$A$1:$D" & MRng).AutoFilter Field:=4, Criteria1:="Pending"
    Range("$A$1:$D" & MRng).Select
   
    ActiveCell.Offset(1, 0).Select
Do Until ActiveCell.EntireRow.Hidden = False
        ActiveCell.Offset(1, 0).Select
Loop
    XCell = ActiveCell
   
    Range(XCell & ":D", new1).Select
       
End If
End With

End Sub

 

[Gaurangg]

I found below code that works as per my need, however it selects the continuous rows whereas I want to select the dynamic range from filtered rows. Please if anyone can help would be much appreciated.

Sub DynamicRangeBasedOnCellValue()
Dim DValue As Variant
Dim DRange As Range
DValue = ActiveSheet.Range("F2").Value ' F2 cell value is 3
Set DRange = ActiveSheet.Range("A1:B" & DValue)
DRange.Select
End Sub

 

[bebo021999]

Your code does not help us much to understand what you want to have in output sheet.
Cells refetence in code does not match with cells reference in sample worksheet
For instant,

Dim new1 As Integer
 new1 = Sheets("EmpList").Range("F2").Value

but cell F2 contains textstring "CZ" (maybe you means range I2?)
Also, sheet Process 1, "pending" is in column E, but your code try to filter column D:

    Range("$A$1:$D" & MRng).AutoFilter Field:=4, Criteria1:="Pending"

It may help a lot if you could "try to manual input the expected output results (in sheet Database?)"

 

[Gaurangg]

It took a lot of search and R&D and finally I could solve my issue to select the rows based on the numbers mentioned in the range.
My apologies to giving incorrect reference to get row count i.e. column "F". Ideally it should refer the column "I"
Below is my updated code with resolution:

Sub CopyRows()

Dim rng As Range

Dim r As Range
Dim n1, n2 As Integer
Dim n As Integer
Dim i As Long
Dim XCell As String
Dim new1 As Integer

 new1 = Sheets("EmpList").Range("I2").Value     ' Apologies to give incorrect reference in earlier code
 
With Sheets("Process1")
'Dim MRng As Range
    On Error Resume Next
    Sheets("Process1").ShowAllData
    On Error GoTo 0
  
If new1 = 0 Then
Exit Sub
Else
Sheets("Process1").Activate
Range("A1:E1").AutoFilter
MRng = Sheet1.Range("A1048576").End(xlUp).Row

    Range("C1").Select
    Range("$A$1:$E" & MRng).AutoFilter Field:=5, Criteria1:="Pending"
    Range("$A$1:$E" & MRng).Select
  
    ActiveCell.Offset(1, 0).Select
Do Until ActiveCell.EntireRow.Hidden = False
        ActiveCell.Offset(1, 0).Select
Loop
    ActiveCell.Resize(new1, 6).Select  'here i could select the number of rows mentioned in the "I" column
    Selection.Copy
    Sheets("Database").Select
    Range("A1048576").End(xlUp).Offset(1, 0).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
      
End If
End With

End Sub