Search, Copy then Paste into a new tab

[tezza]

Hi all,

Hope you can help.

Below is an image of data the our work program produces but it doesn't really do what I need.

What I would like is as follows:

Step 1:
Copy the data into a new tab

Step 2:
Delete any rows that have dates/times in it that doesn't contain "Sickness Absence" in the Description (Col H)

I know some won't have sickness so there won't be any filled rows, but that's fine for the purpose I need.

Ultimately, I just need to see how many sickness days each person has, so if you have a better solution I'm all ears

Thank you

Thank you.

 

[offthelip]

try this:

Sub test()
 Dim outarr()
 lastrow = Cells(Rows.Count, "A").End(xlUp).Row
 inarr = Range(Cells(1, 1), Cells(lastrow, 8))
 ReDim outarr(1 To lastrow, 1 To 8)
 indi = 1
 For i = 1 To lastrow
  If inarr(i, 8) = "Sickness Absence" Then
   For j = 1 To 8
    outarr(indi, j) = inarr(i, j)
   Next j
   indi = indi + 1
  End If
 Next i
 If indi > 1 Then
 Worksheets.Add
 Range(Cells(1, 1), Cells(indi - 1, 8)) = outarr
 Else
  MsgBox " Absence not found"
 End If
 
End Sub

 

[tezza]

try this:

Sub test()
 Dim outarr()
 lastrow = Cells(Rows.Count, "A").End(xlUp).Row
 inarr = Range(Cells(1, 1), Cells(lastrow, 8))
 ReDim outarr(1 To lastrow, 1 To 8)
 indi = 1
 For i = 1 To lastrow
  If inarr(i, 8) = "Sickness Absence" Then
   For j = 1 To 8
    outarr(indi, j) = inarr(i, j)
   Next j
   indi = indi + 1
  End If
 Next i
 If indi > 1 Then
 Worksheets.Add
 Range(Cells(1, 1), Cells(indi - 1, 8)) = outarr
 Else
  MsgBox " Absence not found"
 End If
 
End Sub

Hi, this removes ALL rows without Sickness Absence, which doesn't match my needs.

Delete any rows that have dates/times in it that doesn't contain "Sickness Absence" in the Description (Col H)

It only needs to remove the rows that have dates / times in.

I will however have another use for this initial code so thank you for that

 

[offthelip]

try this code which adds the check for the dates:

Sub test()
 Dim outarr()
 lastrow = Cells(Rows.Count, "B").End(xlUp).Row
 inarr = Range(Cells(1, 1), Cells(lastrow, 8))
 ReDim outarr(1 To lastrow, 1 To 8)
 indi = 1
 For i = 1 To lastrow
  If (IsDate(inarr(i, 2)) And inarr(i, 8) = "Sickness Absence") Or Not (IsDate(inarr(i, 2))) Then
   For j = 1 To 8
    outarr(indi, j) = inarr(i, j)
   Next j
   indi = indi + 1
  End If
 Next i
 If indi > 1 Then
 Worksheets.Add
 Range(Cells(1, 1), Cells(indi - 1, 8)) = outarr
 Else
  MsgBox " Absence not found"
 End If
 
End Sub

 

[tezza]

try this code which adds the check for the dates:

Sub test()
 Dim outarr()
 lastrow = Cells(Rows.Count, "B").End(xlUp).Row
 inarr = Range(Cells(1, 1), Cells(lastrow, 8))
 ReDim outarr(1 To lastrow, 1 To 8)
 indi = 1
 For i = 1 To lastrow
  If (IsDate(inarr(i, 2)) And inarr(i, 8) = "Sickness Absence") Or Not (IsDate(inarr(i, 2))) Then
   For j = 1 To 8
    outarr(indi, j) = inarr(i, j)
   Next j
   indi = indi + 1
  End If
 Next i
 If indi > 1 Then
 Worksheets.Add
 Range(Cells(1, 1), Cells(indi - 1, 8)) = outarr
 Else
  MsgBox " Absence not found"
 End If
 
End Sub

That works great for dates.

Can we also add a check for times?

 

[offthelip]

What sort of check for time do you want ?

 

[tezza]

What sort of check for time do you want ?

I just did a dry run and it works perfectly, thank you.