Find text in table, then copy and paste from another column

[Rishek]

Very new at this. I can barely copy a macro, but I'm willing to try. I'm using the latest version of Word.

Every day I publish a schedule at work and need to cross check it to avoid double booking anyone. I'd like to start automating this cross check since it's a) very time-consuming and b) easy to screw up.

The schedule is divided into tables and the first table has four columns with a row for each event (table is sub-divided by project, see attachment). The first contains the start and end time of the event and the third column has the names of those attending.

I would like to be able to search the table for a name, then in every row containing that name, copy and paste the contents of the first column (i.e. the times) somewhere.

Eventually, I'd like to be able just to set a list of all names to be cross checked have it output. Possibly to some sort of new table, but that's all a ways down the line.

Attached is the template I'm working from, somewhat anonymized. The table I'm referring to is the first one that appears.

Any assistance, appreciated. This is an ongoing project and I'm willing to learn.

19270

[gmayor]

Can you fill the table with some data so we can see what it is that you are trying to extract from where, and can you indicate what you want to do with the times that have been extracted. 'Paste the content somewhere' needs to be explicit.

Where are the search names coming from? Are you going to input the names manually?

[Rishek]

19271

Here's a copy with some data. It's running rehearsals for a theater.

Let's say paste the names into a new excel document with two columns and a row for each extracted item:



NAME
TIME


NAME
TIME


NAME
TIME


NAME
TIME



I have a list of each name I would like to do this with and they do not change, by and large. Ideally, they'd be built into the macro itself, so that it always checks the same names.

[gmayor]

Maybe something like the following which will list the times for all the names in the table.


Option Explicit

Sub ExtractTimes()
Dim xlapp As Object
Dim xlBook As Object
Dim NextRow As Long
Dim oTable As Table
Dim oCell As Range, oTime As Range
Dim iRow As Integer, i As Integer
Dim vName As Variant
On Error Resume Next
Set xlapp = GetObject(, "Excel.Application")
If Err Then
Set xlapp = CreateObject("Excel.Application")
End If
On Error GoTo 0
Set xlBook = xlapp.Workbooks.Add
xlapp.Visible = True
xlBook.sheets(1).Range("A1") = "Name"
xlBook.sheets(1).Range("B1") = "Time"

Set oTable = ActiveDocument.Tables(1)
For iRow = 2 To oTable.Rows.Count
If oTable.Rows(iRow).Cells.Count = 4 Then
Set oCell = oTable.Cell(iRow, 3).Range
oCell.End = oCell.End - 1
If Len(Trim(oCell.Text)) > 0 Then
vName = Split(oCell.Text, ",")
Set oTime = oTable.Cell(iRow, 1).Range
oTime.End = oTime.End - 1
For i = 0 To UBound(vName)
NextRow = xlBook.sheets(1).Range("A" & xlBook.sheets(1).Rows.Count).End(-4162).Row + 1
xlBook.sheets(1).Range("A" & NextRow) = Trim(vName(i))
xlBook.sheets(1).Range("B" & NextRow) = Trim(oTime.Text)
Next i
End If
End If
Next iRow
xlBook.sheets(1).UsedRange.Columns.AutoFit
lbl_Exit:
Set xlapp = Nothing
Set xlBook = Nothing
Set oTable = Nothing
Set oCell = Nothing
Set oTime = Nothing
Set vName = Nothing
Exit Sub
End Sub

[Rishek]

It works! Very cool. Thank you so much.

I am, of course, so impressed, that I'm going to press my luck.

The best thing is probably that I attach a slightly more accurate mock up of the document I'm starting with (I was in a bit of rush putting the data in). 19278

How do I modify this line so that the the names also split at a parenthesis or a line break (if you run the code on the document, you'll see why this might be important):


vName = Split(oCell.Text, ",")


And is there any way to remove the parentheses and the REL and N/A abbreviations from the results as well?

And to sort the results A to Z by name?

And finally, to extract the columns for Location and Event as well? I've been toying with the code a bit, changing numbers to see what happens, but my only success is in adding two columns to the excel sheet:
[code}xlBook.sheets(1).Range("C1") = "Location"
xlBook.sheets(1).Range("D1") = "Event"[/code]

After I have this data, we manually record the times onto the following time sheets, by simply coloring in the time blocks color coded by show (yes, we do half if the event starts/ends at :15 or :45). We also do one for the Music Staff and the Venues. And we add the hours for each name.

19277
19279

The end goal would be to totally automate this so that the crosscheck more or less takes care of itself. I suspect the schedule itself needs rejigging so that the data is more easily machine readable. Anyone have thoughts on where the best starting point would be?

Once again, thanks for the code! It's really helpful: now we don't need to scan the schedule line by line for each person!

[gmayor]

Hmmm. Your revised document doesn't exactly make the job any easier. I'll have to think on that for a bit. In the meantime, what is it that you to do with the names in the parentheses? Do you want to add them just like the other names that are not in parentheses? The additional columns and the sorting are not an issue, but with regard to the sorting, do you want the sorting to be alphabetical within the times or alphabetical regardless of the times?

[Rishek]

Thanks for the quick reply! Yeah, it sure doesn't make it much easier, but it does make the scope of the problem clear.

I've figured out how to change which column is extracted, but I'm afraid as a novice, I'm not used to thinking in variables and dimensions.

With the names in Parentheses, I would say add them like the others with a * afterwards to indicate that they were in parentheses (regrettably, parenthetical names have different meanings, N/A being different from REL being different simply from a name in parentheses (these are understudies).

[gmayor]

This is no task for a novice, and in any case I am not convinced it can be achieved, because of the inconsistency of formatting and the addition of comments in some of the name cells, including comments in parentheses. There are also some names in italics after some of the bracketed sections. VBA requires certainty or certainty that can be derived. Thus you can split a string of text by repetitive characters, such as the commas, but when you throw random texts and names in parentheses into the mix, it all gets rather confused.

Frankly I think it would have been better to have begun the process in Excel and write the values from the Excel sheet the macro I posted creates to the cells of the table, but that would mean redesigning the whole concept, which frankly is beyond the scope of this forum.

[Rishek]

That's pretty much what I feared. I'll probably tweak the formatting a bit to make things easier. If I were just to ignore the parentheses (or just accept the issues, could I also add a split at line breaks? I think my solution will also involve a find and replace macro in the resulting excel sheet.

How would I add the extra columns (location and event) to the extracted spreadsheet? If I've got that, then I have manipulatable data set to work from, which is a very good start.

Again, thanks so much. I feel really sheepish asking for all this, but it's such a huge help and even knowing the limitations is a good beginning.

[gmayor]

Define two new range variables

Dim oLocation As Range, oEvent As Range
Then include the additional headings to the title row where shown below


Set xlBook = xlapp.Workbooks.Add
xlapp.Visible = True
xlBook.sheets(1).Range("A1") = "Name"
xlBook.sheets(1).Range("B1") = "Time"
xlBook.sheets(1).Range("C1") = "Location" 'Add the Location heading
xlBook.sheets(1).Range("D1") = "Event" ' Add the Event heading
Define the two range variables after the already defined range variables for name and time


Set oEvent = oTable.Cell(iRow, 2).Range 'The cell to process
oEvent.End = oEvent.End - 1 'Remove the cell end character from the range
Set oLocation = oTable.Cell(iRow, 4).Range
oLocation.End = oLocation.End - 1

Then add the two lines of code to write those values to the worksheet


For i = 0 To UBound(vName)
NextRow = xlBook.sheets(1).Range("A" & xlBook.sheets(1).Rows.Count).End(-4162).Row + 1
xlBook.sheets(1).Range("A" & NextRow) = Trim(vName(i))
xlBook.sheets(1).Range("B" & NextRow) = Trim(oTime.Text)
xlBook.sheets(1).Range("C" & NextRow) = Trim(oLocation.Text) 'Add the location
xlBook.sheets(1).Range("D" & NextRow) = Trim(oEvent.Text) 'Add the event
Next i

[Rishek]

Excellent. That also helps a lot since now I'm starting to understand how the code and the variables at least fit together if not how their dimensions work. I'm going to mark this thread solved and play around with the whole thing a bunch more.

And again. Thank you.

[Rishek]

Actually ...

I've been playing around with some things and considering the problem. Which has brought me to two further questions.

Question 1:
The extracted data is great except where the comma delineation isn't present or there's something in the table cell that is irrelevant.

Irrelevant: Anything in parentheses. Anything in Bold text.
Relevant, but problematic because of the lack of comma delineation: non-parenthetical items after a line break.

My non-macro solution would be using advanced find and replace with wildcards to delete all parenthesis \(*\), all like breaks with ^p and then all bold text, then run the macro, then undo changes or failing that, reopen the document without saving changes.


How would I do the above with a macro?

I tried playing with the macro like this:


vname = Split(o.Cell.Text, "," "^p" "\(*\)")

But it failed and attempting to debug crashed word so hard it deleted all my macros.:biggrin:

Luckily, I really didn't have very many at all.


Question 2:

The created events column is useful, but how would I alter

Set oEvent = oTable.Cell(iRow, 2).Range 'The cell to process
oEvent.End = oEvent.End - 1


So that the iRow extracts the header (the gray section with the name of the play or show) instead?

Sorry to reopen this. Have ordered a VBA book, but it won't arrive until next week. Thoughts appreciated.

[Rishek]

So because I needed to do the same thing, but focusing on the locations, I chopped your original code around to:


Sub ExtractLocTime()
Dim xlapp As Object
Dim xlBook As Object
Dim NextRow As Long
Dim oTable As Table
Dim oCell As Range, oTime As Range
Dim oLocation As Range, oEvent As Range
Dim iRow As Integer, i As Integer
Dim vName As Variant
On Error Resume Next
Set xlapp = GetObject(, "Excel.Application")
If Err Then
Set xlapp = CreateObject("Excel.Application")
End If
On Error GoTo 0
Set xlBook = xlapp.Workbooks.Add
xlapp.Visible = True
xlBook.sheets(1).Range("A1") = "Location"
xlBook.sheets(1).Range("B1") = "Time"
xlBook.sheets(1).Range("C1") = "Event"


Set oTable = ActiveDocument.Tables(1)
For iRow = 2 To oTable.Rows.Count
If oTable.Rows(iRow).Cells.Count = 4 Then
Set oCell = oTable.Cell(iRow, 4).Range
oCell.End = oCell.End - 1
If Len(Trim(oCell.Text)) > 0 Then
vName = Split(oCell.Text, ",")
Set oTime = oTable.Cell(iRow, 1).Range
oTime.End = oTime.End - 1
For i = 0 To UBound(vName)
Set oEvent = oTable.Cell(iRow, 2).Range 'The cell to process
oEvent.End = oEvent.End - 1 'Remove the cell end character from the range
Set oLocation = oTable.Cell(iRow, 4).Range
oLocation.End = oLocation.End - 1
NextRow = xlBook.sheets(1).Range("A" & xlBook.sheets(1).Rows.Count).End(-4162).Row + 1
xlBook.sheets(1).Range("A" & NextRow) = Trim(oLocation.Text)
xlBook.sheets(1).Range("B" & NextRow) = Trim(oTime.Text)
xlBook.sheets(1).Range("C" & NextRow) = Trim(oEvent.Text) 'Add the event
Next i
End If
End If
Next iRow
xlBook.sheets(1).UsedRange.Columns.AutoFit
lbl_Exit:
Set xlapp = Nothing
Set xlBook = Nothing
Set oTable = Nothing
Set oCell = Nothing
Set oTime = Nothing
Set vName = Nothing
Exit Sub
End Sub


Which is fairly terrible since it leaves in a lot of stuff that doesn't get used and comma separates the values with vName. I attempted to see if I could at least fold this into the original by changing all the "sheets(1)" to "sheets(2)" thinking maybe that might create a new sheet in the workbook. Didn't work, needless to say.

Still trying to figure out how to extract the heading values for each section to the events column. Perhaps making the oEvent search upwards to iRow (1) and copy the value in the first merged cell it encounters?

[gmaxey]

Question 1 above:


Sub ScratchMacro()
'A basic Word macro coded by Greg Maxey
Dim oRng As Range
Dim arrItems() As String
Set oRng = Selection.Range
arrItems = Split(Replace(Replace(Replace(oRng.Text, Chr(11), " "), ")", ""), "(", ""), ", ")
lbl_Exit:
Exit Sub
End Sub

[Rishek]

Thanks for replying. I'm not entirely sure what that macro will do. It seems to be automatically formatting a bunch of stuff so as to make the split command run more smoothly. It might well apply to some of the myriad of other questions I've posted on this forum. Could you tell me how I should use it? Sorry for being thick. Coffee brewing as I type.

[gmaxey]

It will do what seems to me you asked to do. It will take parens and line breaks out of the string that you want create an array from on the delimiter ","

Change oRng = Selection.Range to
oRng = Whatever defines the range of the string you want to use.

[Rishek]

Gotcha! Thanks. Wasn't thinking far enough up the thread.