VBA: Filter issue

[sunilbsrv2k]

Hi All,

I have written a VBA macro that will filter a table based on the values (Employee ID) in another sheet.

This will further extract randomly one row for each filtered criteria.

It is running fine; however each time, the code executes successfully but omits 3 to 4 values (Employee IDs) though the data exists for them in the table.

Could you please help. Below is my code:

Sub Multi_Task()
Dim wb, wb1 As Workbook
Dim ws, ws1 As Worksheet
Dim rng, rng1 As Range
Dim i, n As Integer
'Sheets("Sheet2").Range("A:AH").Clear
ThisWorkbook.Sheets("Sheet3").Range("A:AH").Clear
ThisWorkbook.Sheets("Sheet1").Activate
Set rng = ThisWorkbook.Sheets("Sheet1").Range("D2:D60")
Set wb = Workbooks.Open("File name")
Set ws = wb.Worksheets("MEMBERLOOKUP TASK")
ws.Range("$A$1:$L" & Cells(Rows.Count, "A").End(xlUp).Row).SpecialCells(xlCellTypeVisible).AutoFilter Field:=7

forloop:
For Each cell In rng
ThisWorkbook.Sheets("Sheet2").Range("A:AH").Clear
'ThisWorkbook.Sheets("Sheet1").Activate
'If cell.Value = "" Then GoTo forloop
MsgBox cell.Row & "," & cell
ws.Activate
ws.Range("A1").AutoFilter Field:=7, Criteria1:=cell.Value
i = Application.WorksheetFunction.Subtotal(3, Range("A1:A65536")) ' & Rows.Count).End(xlUp).Offset(1, 0))
'MsgBox i ' Range("A22:A" & Rows.Count).End(xlUp).Offset(1, 0)

Set arng = Range("A22:L" & Cells(Rows.Count, "A").End(xlUp).Row).SpecialCells(xlCellTypeVisible) '.Range("A2:A" & Cells(Rows.Count, "A").End(xlUp).Row).SpecialCells(xlCellTypeVisible).Copy
arng.Copy Destination:=ThisWorkbook.Sheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
'ThisWorkbook.Worksheets("Sheet2").Range("A2") = arng
'Next
'MsgBox n & " ," & n

'Sheets("Sheet2").Activate
'Sheets("Sheet2").Range("A:AH").Clear
Rndm = RndInt(3, i)
For n = 2 To i - 1
'Sheets("Sheet2").Range("A:AH").Clear
If n = Rndm Then
'MsgBox n & "," & Rndm
'ThisWorkbook.Sheets("Sheet2").Range("A" & n).EntireRow.Copy Destination:=ThisWorkbook.Sheets("Sheet3").Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
ThisWorkbook.Sheets("Sheet2").Range("A" & n).EntireRow.Copy Destination:=wb.Sheets("MEMBERLOOKUP TASK SAMPLING").Range("B" & Rows.Count).End(xlUp).Offset(1, -1)
'ThisWorkbook.Sheets("Sheet2").Range(Cells("A" & n), Cells("L" & n)).Copy 'Destination:=wb.Sheets("FMM TASK SAMPLING").Cells("B" & Rows.Count).End(xlUp).Offset(1, 0)
'wb.Sheets("FMM TASK SAMPLING").Cells("B" & Rows.Count).End(xlUp).Offset(1, 0).Paste

End If

Next

Next
ws.Range("$A$1:$L" & Cells(Rows.Count, "A").End(xlUp).Row).SpecialCells(xlCellTypeVisible).AutoFilter Field:=7
wb.Save
End Sub

 

[jkpieterse]

Not without seeing your data I'm afraid.

 

[sunilbsrv2k]

Hi,

Please let me know how I can share the data with you, as I my not be able to share it publicly.

Thanks,