Do untill command

[Adrac]

Hello all,

I have a macro that looks in A and finds a name, then finds a word of text in a cell the copies information.
I would like it to keep finding the word cells until it reaches another word cell:

Example:

Cells.Find(What:="Bob", After:=ActiveCell).Activate
Cells.Find(What:="Inbound", After:=ActiveCell).Activate
ActiveCell.Offset(0, 2).Range("A1").Copy
ActiveCell.Offset(0, 16).Range("A1").Select
ActiveSheet.Paste
***this ia where i want it to go to***
do this command above until it finds the word 'Wrokgroup' in a cell then next command (person)

Can anyone help?

Adrac

 

[Adrac]

ok this one is the total result for nBnd needs to go into Workbook 2014.xlsb. Here we have everyones first name in Row 3 then we have dates starting from 1/1/2014 and goes all the way down to the end of year. So my script (well should) finds the persons name in Row 3 then finds the last working days date and enters nBnd into the cell. I need to intigrate this commanding into what you have done. Thanks

(is there an nicer way of putting in a sprreadsheet section like below)

Adrac

A B C
3 Adam Kim
4 01/01/2014
5 02/01/2014 11 8
6 03/01/2014 5 7
7 04/01/2014
8 05/01/2014
9 06/01/2014 21 15
10 07/01/2014 17 6
11 08/01/2014 17 20
12 09/01/2014 9 5
13 10/01/2014 18 15
14 11/01/2014

 

[brian.wethington]

I generally produce records that I can easily develop into a pivot table rather than a makeshift cross tab. This allows for much more flexibility overall and allows you to add greater dimensions later if you would like. Basically how I would do this in this way column A = Date, B = Name, C = Inbound Calls, D = 4th Element (if you ever add one), E = 5th Element

It seems like you have 2 numbers in some cases, Is this 2nd number or 4th element coming from the same Data we have extracted the inbound calls from? It is not that large of a thing, but a new element is much easier to add to a record method than it is to add to a cross tab report. In the end a cross tab report that is based on the record method can be easily made with a pivot table or other methods.

Having stated all this, there is nothing wrong with the way this is developed and it can be done. It just is a matter of preference, and it may require more work in the front end

 

[Adrac]

edit> The main information comes from a main data base and tthis form gets over ridden everyday so we need to extract this and add it to a main spreradsheet. unfortunatly cant be a pivot as the info would change daily.

in fact after looking at this, we could use the name range in row 3 instead of making a new one.
I have changed the names in row 3 to the same names in the 'NameA' arrey so it might be easyer to control with lesser script.
So can we add to the script from the results go onto main workbook and look for person then look for last working day?

	Baker, Adam	Barnes, Kim
01/01/2014
02/01/2014	11	8
03/01/2014	5	11
04/01/2014
05/01/2014

<TBODY>
</TBODY>

 

[brian.wethington]

For the record entry method it would look like this:

Sub RecordInbound()
Dim nBnd As Double, x As Integer, Dt As Date, NameA() As Variant
Dim Rng As Range, CE1 As Range, Rw As Range, CE2 As Range, RcrdSh As Worksheet
Dim DtSh As Worksheet, RcrdWb As Workbook, DtWb As Workbook

NameA() = Array("Baker, Bob", "Barnes, Kim", "Davies, Nick", _
    "Bryant, Nick", "Davies, James", "Thomas, CJ", _
    "Thompson, Reggie")

Set RcrdWb = Workbooks("Workbook 2014.xlsb")
Set RcrdSh = RcrdWb.Worksheets("Results")
Set DtWb = Workbooks("data.xlsx")
Set DtSh = DtWb.Worksheets("Sheet1")
Dt = WorksheetFunction.WorkDay(Date, -1)
For x = 0 To UBound(NameA)
    Set CE1 = DtSh.Range("A:A").Find("*" & NameA(x) & "*", After:=Cells(1, 1))
    If Not CE1 Is Nothing Then
        Set Rw = DtSh.Range(CE1, DtSh.Cells(Rows.Count, "A").End(xlUp)).Find("*Workgroup*", After:=CE1)
        If Rw Is Nothing Then Set Rw = DtSh.Cells(Rows.Count, "A").End(xlUp)
        Set Rng = Range(CE1, Rw)
        nBnd = WorksheetFunction.SumIf(Rng, "*inbound*", Rng.Offset(0, 2))
        Set CE2 = RcrdSh.Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
        CE2 = Dt
        CE2.Offset(0, 1) = NameA(x)
        CE2.Offset(0, 2) = nBnd
    End If
Next
End Sub

For the cross tab method it would look something like this:

Sub CrossTabInbound()
Dim nBnd As Double, x As Integer, Dt As Date, NameA() As Variant
Dim Rng As Range, CE1 As Range, Rw As Range, CE2 As Range, RcrdSh As Worksheet
Dim DtSh As Worksheet, RcrdWb As Workbook, DtWb As Workbook
Dim Dr As Integer, Nr As Integer

NameA() = Array("Baker, Bob", "Barnes, Kim", "Davies, Nick", _
    "Bryant, Nick", "Davies, James", "Thomas, CJ", _
    "Thompson, Reggie")

Set RcrdWb = Workbooks("Workbook 2014.xlsb")
Set RcrdSh = RcrdWb.Worksheets("Results")
Set DtWb = Workbooks("data.xlsx")
Set DtSh = DtWb.Worksheets("Sheet1")
Set CE2 = RcrdSh.Range("A:A").Find(Format(WorksheetFunction.WorkDay(Date, -1), "M/D/YYYY"))
If CE2 Is Nothing Then
    MsgBox ("Date not found in Results Sheet. Exiting process!")
    Exit Sub
End If
Dr = CE2.Row
For x = 0 To UBound(NameA)
    Set CE1 = DtSh.Range("A:A").Find("*" & NameA(x) & "*", After:=Cells(1, 1))
    If Not CE1 Is Nothing Then
        Set Rw = DtSh.Range(CE1, DtSh.Cells(Rows.Count, "A").End(xlUp)).Find("*Workgroup*", After:=CE1)
        If Rw Is Nothing Then Set Rw = DtSh.Cells(Rows.Count, "A").End(xlUp)
        Set Rng = Range(CE1, Rw)
        nBnd = WorksheetFunction.SumIf(Rng, "*inbound*", Rng.Offset(0, 2))
        Set CE2 = RcrdSh.Range("A3", RcrdSh.Cells(1, Columns.Count).End(xlToLeft)).Find(NameA(x))
        If CE2 Is Nothing Then
            MsgBox (NameA(x) & " not found in Results Sheet. Exiting process!")
            Exit Sub
        End If
        Nr = CE2.Column
        Set CE2 = RcrdSh.Cells(Dr, Nr)
        CE2 = nBnd
    End If
Next
End Sub

 

[brian.wethington]

just picked up on an error in the finding of the name in the CrossTabInbound
This single line:

        Set CE2 = RcrdSh.Range("A3", RcrdSh.Cells(1, Columns.Count).End(xlToLeft)).Find(NameA(x))

This line should be changed to:

        Set CE2 = RcrdSh.Range("A3", RcrdSh.Cells(3, Columns.Count).End(xlToLeft)).Find(NameA(x))

 

[Adrac]

this line is erroring if the data sheet is not showing, can we make it go through without this being visible

Set Rw = DtSh.Range(CE1, DtSh.Cells(Rows.Count, "A").End(xlUp)).Find("*Workgroup*", After:=CE1)

EDIT> ignore below lol youve seen it already, thanks let me try it now...

secondly it is not seeing the names in the row. but can see where it is looking for it. The names are in row 3 going across : B3, C3, D3, E3...

sorry to keep coming back to you but this code has now gone beyond my ability and knowledge but thank you for your support.

Adrac</SPAN>

 

[brian.wethington]

this line is erroring if the data sheet is not showing, can we make it go through without this being visible

Set Rw = DtSh.Range(CE1, DtSh.Cells(Rows.Count, "A").End(xlUp)).Find("*Workgroup*", After:=CE1)

I am not sure what is causing that error though, but if that is causing an error it will cause no data to be moved if we use a on error goto next or something like that. Therefore we need to work through the reasons that might be an error. Can you give me the error reason that is given?

The reasons that line of code that might error are not that the sheet is not active or select; however, if there is not a Sheet1 in the file data.xlsx (which also must be open prior to the code running) then it would cause an error. If you need the code to open the workbook data.xlsx then we can make that happen for sure. If we need to change the sheet we are referring to than we can certainly do that as well. I just need to know if the sheet being referred to need to be dynamic or if it can always be the same. I suppose the same is true for the workbook.