Select based on partial string then delete based on full string

[Bounces]

Hello,

Working with a scheduling report and trying ultimately to get it down to a line item report with the associate information and their earliest start and latest end for the week. Already made a lot of fixes to the formatting involving junking empty cells and trash data, but running into a road block on some of the trash data.

Here is the format of the report at this point. Names have been changed to protect the innocent.

[TABLE="width: 500"]
<tbody>[TR]
[TD]Agent: 2366 Bacon, Kevin[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Date[/TD]
[TD]Start[/TD]
[TD]End[/TD]
[/TR]
[TR]
[TD]5/19/2013[/TD]
[TD]8:30 AM[/TD]
[TD]5:00 PM[/TD]
[/TR]
[TR]
[TD]5/20/2013[/TD]
[TD]8:30 AM[/TD]
[TD]5:00 PM[/TD]
[/TR]
[TR]
[TD]5/21/2013[/TD]
[TD]8:30 AM[/TD]
[TD]5:00 PM[/TD]
[/TR]
[TR]
[TD]5/22/2013[/TD]
[TD]Off[/TD]
[TD]Off[/TD]
[/TR]
[TR]
[TD]Agent: 2366 Bacon, Kevin[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Date[/TD]
[TD]Start[/TD]
[TD]End[/TD]
[/TR]
[TR]
[TD]5/23/2013[/TD]
[TD]9:00 AM[/TD]
[TD]5:30 PM[/TD]
[/TR]
[TR]
[TD]5/24/2013[/TD]
[TD]10:00 AM[/TD]
[TD]6:30 PM[/TD]
[/TR]
[TR]
[TD]5/25/2013[/TD]
[TD]Off[/TD]
[TD]Off[/TD]
[/TR]
[TR]
[TD]Agent: 8843 Dinero, Robert[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Date[/TD]
[TD]Start[/TD]
[TD]End[/TD]
[/TR]
</tbody>[/TABLE]


So what I need is something that will iterate through the report...such as an while and find the cells in column A that start with "Agent:" It needs to compare that cell to a stored value to see if this "Agent:" is a repeat. If it is then it needs to delete that row and the next one and shift up. If it is not then it overwrites this "Agent:" with the previous one in the stored value and continues the while.

I know what I want to do...but not shure on the code cause I am not great at VBA.

Help?

Oh...if it matters probably need to allow for about 10k line items to iterate through...right now report is at 6k...but allow room to grow.

Thanks!

 

[JLGWhiz]

Here is code based on your posted description of what you want to happen. I suggest you try this on a copy, because I don't believe you really want what you described.

Sub wipeOut()
Dim sh As Worksheet, lr As Long, rng As Range, c As Range
Set sh = Sheets(1) 'Edit sheet name
lr = sh.Cells(Rows.Count, 1).End(xlUp).Row
Nm = InputBox("Enter Name to Search", "SEARCH ITEM")
Set rng = sh.Range("A2:A" & lr)
    For Each c In rng
        If Left(c.Value, 5) = "Agent" Then
            If (InStr(c.Value, Nm)) > 0 Then
                c.Resize(2, 1).EntireRow.Delete
            Else
                c.Replace c.Value, Nm
            End If
        End If
    Next
End Sub

 

[Bounces]

I see the confusion in my description...Sorry about that.

What I said was "If it is not then it overwrites this "Agent:" with the previous one in the stored value and continues the while."

What I meant by that is If the value in cell A29 say is not equal to the value of Nm then A29 becomes the new Nm and the For loop continues. Right now the code has Nm replacing A29 and all other cells that start with Agent.

Sorry again about the confusion. How would I change the code to reflect this desire.

 

[Bounces]

I fixed it. Sorry again about the confusion. Here is what I have now...

Sub wipeOut()Dim sh As Worksheet, lr As Long, rng As Range, c As Range
Set sh = Sheets("Working Sheet") 'Edit sheet name
lr = sh.Cells(Rows.Count, 1).End(xlUp).Row
Nm = InputBox("Enter Name to Search", "SEARCH ITEM")
Set rng = sh.Range("A2:A" & lr)
    For Each c In rng
        If Left(c.Value, 5) = "Agent" Then
            If (InStr(c.Value, Nm)) > 0 Then
                c.Resize(2, 1).EntireRow.Delete
            Else
                Nm = c.Value
            End If
        End If
    Next
End Sub

Last question is if the InputBox is really necessary? Since all the data is in the spreadsheet couldn't I set Nm to some Null value to start and then have it overwrite that null when it comes to the first "Agent:..." string? From there the loop would resolve everything.

Would it be Dim Nm As String?

 

[JLGWhiz]

I put the inputbox in because the OP referred to a stored value but didn't specify where it was stored. You dan modify the code in any fashion you see fit. I just put it out there according to what the OP described.

 

[Bounces]

Need one more piece of help on this...I am adapting the above code to use for my build report phase...but I am getting an error message when I try to iterate through the For Loop...I am sure I am making some kind of syntax error.

It works for the first iteration, but then throws an error on the c.Resize(9,3).Select line. "It says Run-time error '1004': Select method of Range class failed." Thoughts?

Sub buildReport()Dim sh1 As Worksheet, lr As Long, rng As Range, c As Range, c1 As Integer
Set sh1 = Sheets("Working Sheet") 'Edit sheet name
Set sh2 = Sheets("Reporting Sheet")
Sheets("Reporting Sheet").Select
Range("A2").Select
Sheets("Working Sheet").Select
lr = sh1.Cells(Rows.Count, 1).End(xlUp).Row
Nm = InputBox("Enter Name to Search", "SEARCH ITEM")
Set rng = sh1.Range("A2:A" & lr)
    For Each c In rng
        If Left(c.Value, 5) = "Agent" Then
            c.Resize(9, 3).Select          ' Error occurs here on second time through FOR.
            Selection.Copy
            Sheets("Reporting Sheet").Select
            ActiveCell.Offset(0, 7).Select
            ActiveCell.PasteSpecial (xlPasteAll)
            ActiveCell.Offset(0, -7).Select
            'Avaya ID
            ActiveCell.FormulaR1C1 = "=MID(RC[7],FIND("":"",RC[7])+2,4)"
            ActiveCell.Offset(0, 1).Select
            'Agent Name
            ActiveCell.FormulaR1C1 = "=MID(RC[6],FIND("":"",RC[6])+7,99)"
            ActiveCell.Offset(0, 1).Select
            'Earliest Start
            ActiveCell.FormulaR1C1 = "=MIN(R[2]C[6]:R[8]C[6])"
            ActiveCell.Offset(0, 1).Select
            'Latest End
            ActiveCell.FormulaR1C1 = "=MAX(R[2]C[6]:R[8]C[6])"
            'Replace Formulas with Values
            Range(ActiveCell, ActiveCell.Offset(0, -3)).Select
            Selection.Copy
            Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                :=False, Transpose:=False
            'Remove Data
            Range(ActiveCell.Offset(0, 7), ActiveCell.Offset(8, 9)).Select
            Selection.Delete
            'Next Line
            ActiveCell.Offset(1, 0).Select
            End If
    Next
End Sub

Next post will be desired output.

 

[Bounces]

So here is a table of the desired output...

[TABLE="width: 311"]
<colgroup><col><col><col><col></colgroup><tbody>[TR]
[TD]Avaya ID[/TD]
[TD]Agent Name[/TD]
[TD]Earliest Start[/TD]
[TD]Latest End[/TD]
[/TR]
[TR]
[TD]1030[/TD]
[TD]Bacon,Kevin[/TD]
[TD="align: right"]8:30:00 AM[/TD]
[TD="align: right"]7:30:00 PM[/TD]
[/TR]
[TR]
[TD]1031[/TD]
[TD]Dinero,Robert[/TD]
[TD]10:00:00 AM[/TD]
[TD] 7:00:00PM
[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]
I am using an area to the right of my report to hold the data on this page so I don't have to deal with RC conversions...Lazy and inelegant I know, but that's why I am not a programmer.

So any help that could be provided would be appreciated.