Locate text in range (multiple occurrences) and report other cell insame column?

[ulrik.hillaert]

Dear,

I rarely give up on those things, but I've been looking on this problem for ages and I don't seem to get it working.

What I basically want to do is looking op one certain text string in a range, with multiple occurences, and report for each of these occurences different values from the same column. eg the search returns as first result cell A7, and I want in that case to report cell A9, A12. If there's another place in the range, eg cell D4, where the same string occurs, I want to report D6, D9.
I hope that the attached file ( https://docs.google.com/open?id=0B72kGj3AVfwnTGtZak1IOTF4d3M )will make things clear. I start with the data in sheet1 and I want to generate an overview like in Sheet "Clint Eastwood", preferentially sorted by date, preferentially not manually as I did in this sample file
I've been messing with (h)(v)lookup, index and match but don't get it to work.

I figured out how to get the different row and column numbers where my lookupvalue is situated with:



=(SMALL(IF($A$1=Sheet1!$B$2:$K$13,ROW(Sheet1!$B$2:$K$13)),COUNTIF($L$1:L2,L1)))
and


=(SMALL(IF($A$1=Sheet1!$B$2:$K$13,COLUMN(Sheet1!$B$2:$K$13)),COUNTIF($L$1:L2,L1)))

I have added in column L1:L20 0 1 1 1 1 1 1 ... just to add up and get thesmallest, second smallest, third smallest,... with countif

However, the main problem I have is that this approach always combines thetwo n-smallest numbers for rows and columns.
In the excel file attached, this is not a problem for the first lookup value since both the column and row numbers are the smallest in the range(row 5 and column2). However, when I come to the second values, the row number is 4, but the corresponding column value is not the second smallest number(10), but the third smallest(13). Hence, this approach leaves me with the wrong combinations (row 4 with column 10 and row 7 with column 13, while it should be row 4 with column 13, and row 7 with column

Help!

Best regards,
Ulrik

 

[Ron Rosenfeld]

Dear,

I rarely give up on those things, but I've been looking on this problem for ages and I don't seem to get it working.

What I basically want to do is looking op one certain text string in a range, with multiple occurences, and report for each of these occurences different values from the same column. eg the search returns as first result cell A7, and I want in that case to report cell A9, A12. If there's another place in the range, eg cell D4, where the same string occurs, I want to report D6, D9.
I hope that the attached file ( https://docs.google.com/open?id=0B72kGj3AVfwnTGtZak1IOTF4d3M )will make things clear. I start with the data in sheet1 and I want to generate an overview like in Sheet "Clint Eastwood", preferentially sorted by date, preferentially not manually as I did in this sample file
I've been messing with (h)(v)lookup, index and match but don't get it to work.

I figured out how to get the different row and column numbers where my lookupvalue is situated with:



=(SMALL(IF($A$1=Sheet1!$B$2:$K$13,ROW(Sheet1!$B$2:$K$13)),COUNTIF($L$1:L2,L1)))
and


=(SMALL(IF($A$1=Sheet1!$B$2:$K$13,COLUMN(Sheet1!$B$2:$K$13)),COUNTIF($L$1:L2,L1)))

I have added in column L1:L20 0 1 1 1 1 1 1 ... just to add up and get the smallest, second smallest, third smallest,... with countif

However, the main problem I have is that this approach always combines the two n-smallest numbers for rows and columns.
In the excel file attached, this is not a problem for the first lookup value since both the column and row numbers are the smallest in the range(row 5 and column2). However, when I come to the second values, the row number is 4, but the corresponding column value is not the second smallest number(10), but the third smallest(13). Hence, this approach leaves me with the wrong combinations (row 4 with column 10 and row 7 with column 13, while it should be row 4 with column 13, and row 7 with column

Help!

Best regards,
Ulrik

Looking at your example workbook, it seems to me that what you might really want to do is summarize all of the information on Sheet 1, by stakeholder. with a separate worksheet for each stakeholder.
This is more easily done with a VBA macro.

1. Generate a list of stakeholders (unique names only).
2. For each stakeholder, extract the associated Action, Symposium and Date (and maybe also Responsible?)
3. Generate a new worksheet (or replace the data on a pre-existing workshee) with all of the data. Sort by date; NAME the worksheet with the Stakeholder name.

Code to generate a list of unique stakeholder names is below. If this is an approach you would like to pursue, post back and I'll work further on it.

To enter this Macro (Sub), <alt-F11> opens the Visual Basic Editor.
Ensure your project is highlighted in the Project Explorer window.
Then, from the top menu, select Insert/Module and
paste the code below into the window that opens.

To use this Macro (Sub), <alt-F8> opens the macro dialog box. Select the macro by name, and <RUN>.

======================================
Option Explicit
Sub StakeholderSummary()
Dim colStakeholder As Collection
Dim r As Range, c As Range
Dim sFirstAddress As String
Dim ws As Worksheet
Dim i As Long
'generate unique list of stakeholders
Set ws = Worksheets("sheet1")
With ws.UsedRange.Columns(1).Cells
Set c = .Find(what:="Stakeholder", LookIn:=xlValues, _
lookat:=xlPart)
If Not c Is Nothing Then
sFirstAddress = c.Address
Set r = c.EntireRow
Do
Set c = .FindNext(c)
If c.Address <> sFirstAddress Then
Set r = Union(r, c.EntireRow)
Else
Exit Do
End If
Loop
End If
End With
With r.SpecialCells(xlCellTypeConstants)
Set colStakeholder = New Collection
For Each c In .Cells
If InStr(1, c.Text, "Stakeholder", vbTextCompare) = 0 Then
On Error Resume Next
colStakeholder.Add Item:=c.Text, Key:=c.Text
On Error GoTo 0
End If
Next c
End With

'Now cycle through list of stakeholders
'Generating worksheet and contents for each

'This code just prints a list of
'stakeholders in the immediate window

For i = 1 To colStakeholder.Count
Debug.Print "Stakeholder: " & colStakeholder(i)
Next i

End Sub
==========================================

 

[ulrik.hillaert]

Dear Ron,
You hit exactly the right spot, that's what I really want to do. I didn't have a clue that VBA would do it. Your solutions looks genious to me, I'm going to try to implement it and keep you updated!

Thank you so much!!!
Best regards,
Ulrik

 

[Ron Rosenfeld]

Dear Ron,
You hit exactly the right spot, that's what I really want to do. I didn't have a clue that VBA would do it. Your solutions looks genious to me, I'm going to try to implement it and keep you updated!

Thank you so much!!!
Best regards,
Ulrik

Below is the code for how I would implement this summarization by stakeholder.
In addition to this code, I would suggest that on your "Sheet 1", you use either a user form or data validation in order to avoid typos (e.g. a dropdown list for stakeholders) and also putting data in the wrong row (your date for Symposium 6 is not in the "date" row).

Note that the code assumes that
the Symposium Names are all in row 1
the Column A headers are always in the order of:
Action
Stakeholder
Responsible
Date

Post back if you have any questions.

=======================================
Option Explicit
Sub StakeholderSummary()
Dim colStakeholder As Collection
Dim r As Range, c As Range
Dim sFirstAddress As String
Dim ws As Worksheet, wsSummary As Worksheet
Dim sStakeholderName As String
Dim aStakeHolder() As Variant
Dim aHeaders As Variant
Dim i As Long, j As Long
'generate unique list of stakeholders
Set ws = Worksheets("sheet1")
With ws.UsedRange.Columns(1).Cells
Set c = .Find(what:="Stakeholder", LookIn:=xlValues, _
lookat:=xlPart)
If Not c Is Nothing Then
sFirstAddress = c.Address
Set r = c.EntireRow
Do
Set c = .FindNext(c)
If c.Address <> sFirstAddress Then
Set r = Union(r, c.EntireRow)
Else
Exit Do
End If
Loop
End If
End With
With r.SpecialCells(xlCellTypeConstants)
Set colStakeholder = New Collection
For Each c In .Cells
If InStr(1, c.Text, "Stakeholder", vbTextCompare) = 0 Then
On Error Resume Next
colStakeholder.Add Item:=c.Text, Key:=c.Text
On Error GoTo 0
End If
Next c
End With

'Now cycle through list of stakeholders
'Generating worksheet and contents for each

'Collect Stakeholder information
aHeaders = VBA.Array("Date", "Symposium", "Action", "Responsible")
For i = 1 To colStakeholder.Count
sStakeholderName = colStakeholder(i)
ReDim aStakeHolder(1 To _
WorksheetFunction.CountIf(ws.UsedRange, sStakeholderName) + 2, _
1 To 4)
aStakeHolder(1, 1) = sStakeholderName
For j = 0 To UBound(aHeaders)
aStakeHolder(2, j + 1) = aHeaders(j)
Next j
j = 3 'first row of data
With ws.UsedRange.Cells
Set c = .Find(what:=sStakeholderName, LookIn:=xlValues, _
lookat:=xlWhole, MatchCase:=False)
If Not c Is Nothing Then
sFirstAddress = c.Address
aStakeHolder(j, 1) = c.Offset(rowoffset:=2) 'date
aStakeHolder(j, 2) = c.Offset(rowoffset:=1 - c.Row) 'Symposium
aStakeHolder(j, 3) = c.Offset(rowoffset:=-1) 'Action
aStakeHolder(j, 4) = c.Offset(rowoffset:=1) 'Responsible

Do
Set c = .FindNext(c)
If c.Address <> sFirstAddress Then
j = j + 1
aStakeHolder(j, 1) = c.Offset(rowoffset:=2) 'date
aStakeHolder(j, 2) = c.Offset(rowoffset:=1 - c.Row) 'Symposium
aStakeHolder(j, 3) = c.Offset(rowoffset:=-1) 'Action
aStakeHolder(j, 4) = c.Offset(rowoffset:=1) 'Responsible
End If
Loop Until c.Address = sFirstAddress
End If
End With

'Generate new or clear old worksheet
Application.ScreenUpdating = False
On Error Resume Next
Set wsSummary = Worksheets(sStakeholderName)
If Err.Number = 9 Then 'worksheet does not exist
Worksheets.Add
ActiveSheet.Name = sStakeholderName
Set wsSummary = Worksheets(sStakeholderName)
End If
On Error GoTo 0

With wsSummary
.Cells.Clear
.Range("A1", .Cells(RowIndex:=UBound(aStakeHolder, 1), _
columnindex:=UBound(aStakeHolder, 2))) = aStakeHolder
.Range(Cells(2, 1), Cells(2, columnindex:=UBound(aStakeHolder, 2))).Font.Bold = True
.Range(.Cells(1, 2), .Cells(1, UBound(aStakeHolder, 2))).EntireColumn.AutoFit
End With

Next i 'process next stakeholder

Application.ScreenUpdating = True
End Sub
===============================

 

[ulrik.hillaert]

Dear Ron,
Impressive how you manage to come up with that, this is way beyond my excel skills. Thank you so much for your time and effort! I'm going to try to implement this in my spreadsheat (which is already a challenge for me )
I hope I can post back to tell you that I got it to work

Best regards,
Ulrik

 

[Ron Rosenfeld]

Dear Ron,
Impressive how you manage to come up with that, this is way beyond my excel skills. Thank you so much for your time and effort! I'm going to try to implement this in my spreadsheat (which is already a challenge for me )
I hope I can post back to tell you that I got it to work

Best regards,
Ulrik

Glad to help. Post back if you have questions. I tried to use variable names that would be sort of explanatory.

 

[ulrik.hillaert]

Dear Ron,

I have tried to implement the code in my original worksheet, but apparently, the simplified model that I posted was too simplified for me to translateit to my original worksheet. Read : I didn't manage to implement it my original worksheet. Can I ask for your help once again?
It might be better to post my "real" spreadsheet:

https://docs.google.com/file/d/0B72kGj3AVfwnaWFXN2Fzck0xdFE/edit

Some little words of explanation:
Worksheet "Sjabloon": Based on this worksheet, the worksheets for the different stakeholders should be generated (format only)
Worksheet "Master": The names in Column "Last name" are the names used for the separate worksheets
Worksheet "Field Mapping" This is a planning worksheet. For each worksheet created based on the names in worksheet master, the corresponding data should be extracted from this worksheet.
Worksheet "Example". This is how the report should look like

As you can see, there is already vba code included to generate the separatetabs for each stakeholder, but I don't manage to "read-out" the worksheet Field mapping as you did in your example.

Hope this all makes sense?
Thank you once again!!!!
Ulrik

 

[Ron Rosenfeld]

Dear Ron,

I have tried to implement the code in my original worksheet, but apparently, the simplified model that I posted was too simplified for me to translate it to my original worksheet. Read : I didn't manage to implement it my original worksheet. Can I ask for your help once again?
It might be better to post my "real" spreadsheet:

https://docs.google.com/file/d/0B72kGj3AVfwnaWFXN2Fzck0xdFE/edit

Some little words of explanation:
Worksheet "Sjabloon": Based on this worksheet, the worksheets for the different stakeholders should be generated (format only)
Worksheet "Master": The names in Column "Last name" are the names used for the separate worksheets
Worksheet "Field Mapping" This is a planning worksheet. For each worksheet created based on the names in worksheet master, the corresponding data should be extracted from this worksheet.
Worksheet "Example". This is how the report should look like

As you can see, there is already vba code included to generate the separate tabs for each stakeholder, but I don't manage to "read-out" the worksheet Field mapping as you did in your example.

Hope this all makes sense?
Thank you once again!!!!
Ulrik

Ulrik,

VBA code will not be saved in an .xlsx workbook, so the code you were using did not come through. Not a problem, I rewrote a quick routine to generate the code, using your template (Sjabloon) which I am assuming will reside in your workbook. That is a convenient place for it, and you could consider making it hidden once you have the workbook working.

However, if this is your "real" spreadsheet, I don't see how you get the results you posted from the Field Mapping to Example.

1. I am assuming that this sheet should really be named "Ulrich" since that is a name that you have in E1.
Is that correct?

2. Do C1 and D1 only get filled in if there are corresponding entries in Title 1 and Title 2 of the Master sheet? And otherwise are they left blank?

3. How is the formula in C2 generated? (where does the '3' come from?)

4. Where do the data in B715 come from? I don't see any "test"'s for Ulrich?

 

[ulrik.hillaert]

Dear Ron,

Thank you for getting back on this. The posting of a worksheet without VBA code shows my proficiency in excel...
Anyway, I have uploaded a good version now.

https://docs.google.com/file/d/0B72kGj3AVfwnUjcwOFFwQ1BtTG8/edit

Currently, the tabs are generated (there might be some dutch wording in thecode, sorry for that) with a button placed in the upper left corner of themaster sheet.
To answer your questions:
1) The different sheets to be generated should come from the master file. The number of names here may vary, but I have foreseen a maximum of 25 names.. This list is populated from the list tab.
2) Your assumption is correct. Using VLOOKUP functions in the sjabloon, these fields are populated based on the data in sheet Master. If there are no title fields, these will indeed be left blank
3)Calculations in C1 and D2 (other cells than in the original example here,but principle is the same)are foreseen in the Sjabloon sheet. For the first one, it just looks at the number of times "Face to face" appears in the Contact method row, combined with "yes" in the executed row. D1 sums all contact methods from the contact method row if they are executed (yes in the executed row)
4)Column A and the layout (colors, most of the borders) are described in the VBA code. The data in cells B9:E18 are generated using an array function which resides on the Sjabloon sheet. This function basically looks for cellE1 (Name) in the Field mapping sheet and populates the cells with the correct data. The example in sheet Ulrich shows the problem with this method: If I insert a stakholders name several times in the same column, my result will depict always the same data (first entry) for that stakeholder. In thisexample, you can see that C9:C18 is exactly the same as D918, whereas itshould give different data for C13:C18 as you can see in the the Field Mapping sheet (column G). In addition, when I don't fill in all the fields in the Field mapping sheet (eg leave the notes row blank). All the data following the cell will shift up (eg executed data are in the notes row). This clearly shows that I should rather use VBA as you earlier suggested, but I'm not capable of translating your earlier code to my worksheet
Thanks again for all the efforts you made!!!!
I hope all of this makes sense?
Best regards,
Ulrik

 

[Ron Rosenfeld]

Dear Ron,

Thank you for getting back on this. The posting of a worksheet without VBA code shows my proficiency in excel...
Anyway, I have uploaded a good version now.

And it is also different from the last one.

I don't have time to work on this today, so let me make a few suggestions/comments.

1. Generating the new sheets with some things in VBA code, and some on the template, is certainly one way of doing it. But given that your format is relatively complex, it might be simpler (and easier to maintain) to generate the new sheets using only the template method, including the formatting.

2. Do NOT use formulas to get the data for the stakeholders. They will be much more difficult to maintain and debug (as you have found out) than working from VBA. Instead,
use the Range.Find method to locate the stakeholder on the Mapping sheet.
read that column into an array
parse out the array into a new array in the order you want the data
write the new array into the appropriate place(s) on the worksheet.

(The reason to work from the VBA array is that it will be faster than continually calling back and forth to the worksheet; but you can use the latter method if it is easier for you and the time penalty is not excessive).

I'll try to look at this later when I have time.

 

[ulrik.hillaert]

Hello Ron,

The reason why I combine the VBA code with the template is that for some ofthe formulas, the target's cell layout is overwritten by the formula, which results in a terrible looking sheet. For that reason, I have put the layout-coding after the copying steps to ensure that it looks a bit reasonable.
I fully agree that it is much better to use VBA to get the stakeholders data, but I'm just not capable of generating the VBA code to do this (all the coding you see is copy-past result with minor adaptations towards layout: Isimply don't understand the logic of the coding). e.g. I don't even know how to start with the find.range thing you describe (but I'm gonna try anyway ). I let it know if I get anywhere, but I do hope you somehow find thetime to take a closer look at it.
Cheers!
Ulrik
PS sorry for the change of the template, the last one is really the definite one.

 

[Ron Rosenfeld]

Hello Ron,

The reason why I combine the VBA code with the template is that for some of the formulas, the target's cell layout is overwritten by the formula, which results in a terrible looking sheet. For that reason, I have put the layout-coding after the copying steps to ensure that it looks a bit reasonable.
I fully agree that it is much better to use VBA to get the stakeholders data, but I'm just not capable of generating the VBA code to do this (all the coding you see is copy-past result with minor adaptations towards layout: I simply don't understand the logic of the coding). e.g. I don't even know how to start with the find.range thing you describe (but I'm gonna try anyway ). I let it know if I get anywhere, but I do hope you somehow find the time to take a closer look at it.
Cheers!
Ulrik
PS sorry for the change of the template, the last one is really the definite one.

Have not forgot you, and am making progress, but slowly.

 

[Ron Rosenfeld]

Hello Ron,

The reason why I combine the VBA code with the template is that for some of the formulas, the target's cell layout is overwritten by the formula, which results in a terrible looking sheet. For that reason, I have put the layout-coding after the copying steps to ensure that it looks a bit reasonable.
I fully agree that it is much better to use VBA to get the stakeholders data, but I'm just not capable of generating the VBA code to do this (all the coding you see is copy-past result with minor adaptations towards layout: I simply don't understand the logic of the coding). e.g. I don't even know how to start with the find.range thing you describe (but I'm gonna try anyway ). I let it know if I get anywhere, but I do hope you somehow find the time to take a closer look at it.
Cheers!
Ulrik
PS sorry for the change of the template, the last one is really the definite one.

Ulrik:

Why do you have a hidden row (Tribiani) in Master?
Must it stay hidden?

-- Ron

 

[Ron Rosenfeld]

Hello Ron,

The reason why I combine the VBA code with the template is that for some of the formulas, the target's cell layout is overwritten by the formula, which results in a terrible looking sheet. For that reason, I have put the layout-coding after the copying steps to ensure that it looks a bit reasonable.
I fully agree that it is much better to use VBA to get the stakeholders data, but I'm just not capable of generating the VBA code to do this (all the coding you see is copy-past result with minor adaptations towards layout: I simply don't understand the logic of the coding). e.g. I don't even know how to start with the find.range thing you describe (but I'm gonna try anyway ). I let it know if I get anywhere, but I do hope you somehow find the time to take a closer look at it.
Cheers!
Ulrik
PS sorry for the change of the template, the last one is really the definite one.

Ulrik,
Never mind about the hidden row. I have a work-around.
-- Ron

 

[Ron Rosenfeld]

Hello Ron,

The reason why I combine the VBA code with the template is that for some of the formulas, the target's cell layout is overwritten by the formula, which results in a terrible looking sheet. For that reason, I have put the layout-coding after the copying steps to ensure that it looks a bit reasonable.
I fully agree that it is much better to use VBA to get the stakeholders data, but I'm just not capable of generating the VBA code to do this (all the coding you see is copy-past result with minor adaptations towards layout: I simply don't understand the logic of the coding). e.g. I don't even know how to start with the find.range thing you describe (but I'm gonna try anyway ). I let it know if I get anywhere, but I do hope you somehow find the time to take a closer look at it.
Cheers!
Ulrik
PS sorry for the change of the template, the last one is really the definite one.

OK, given the accuracy of your last example, the following seems to do a lot of what you want.
Obviously, run this on a copy.
I do not use the "button code" at all, but generate and format each worksheet "on the fly".

See what you think.

If you are going to move things around on the template, or on other sheets, it may require some coding changes.

============================================
Option Explicit
Sub StakeholderWorksheets()
Dim colStakeholders As Collection
Dim wsTemplate As Worksheet
Dim wsMaster As Worksheet
Dim c As Range, r As Range, r2 As Range
Dim sStkHldr As String
Dim sFirstAddress
Dim sHospital As String
Dim vKOL As Variant, vRes() As Variant
Dim i As Long, j As Long, k As Long, l As Long
Dim lImportantActionsCount As Long
Const lNumActions As Long = 10


'Items to map to stakeholder sheet
Dim aMapping As Variant
aMapping = Array("", "Event Description", "Internal Event Lead", "Event Date", "Important Action", "Due Date", "Internal Lead", "Contact Method", "Notes", "Executed")

'get unique list of Stakeholders
'based on Last Name on Master Sheet
'If there are duplicate last names, they will be merged
'If this needs to be checked, must alter code

'Find Last Name column
Set wsMaster = Worksheets("Master")
With wsMaster.Cells
Set c = .Find(what:="Last Name*", after:=[a1], LookIn:=xlValues, _
lookat:=xlWhole, searchorder:=xlByRows, searchdirection:=xlNext, _
MatchCase:=False)
If c Is Nothing Then
MsgBox ("No Last Name column on worksheet: " & wsMaster.Name)
Exit Sub
End If

'Generate list of Unique Last Names
'could sort them if you want, otherwise will be in order as on Masster
Set r = Range(c.Offset(rowoffset:=1), .Cells(.Rows.Count, c.Column).End(xlUp))
Set colStakeholders = New Collection
On Error Resume Next
For Each c In r
If Len(Trim(c.Text)) > 0 Then colStakeholders.Add Item:=c.Text, Key:=c.Text
Next c
On Error GoTo 0

End With

'Generate worksheets for each Stakeholder
'If worksheet already present, delete it and create new one
'Will use Sjabloon but remove all the formulas
'Should probably have Sjabloon as a hidden worksheet
'or Generate this differently
Set wsTemplate = Worksheets("Sjabloon")
On Error Resume Next
wsTemplate.Cells.SpecialCells(xlCellTypeFormulas).ClearContents
On Error GoTo 0

For i = 1 To colStakeholders.Count
'Is worksheet already present?
sStkHldr = colStakeholders(i)
On Error Resume Next
Application.DisplayAlerts = False
Worksheets(sStkHldr).Delete
Application.DisplayAlerts = True
On Error GoTo 0
wsTemplate.Copy after:=Worksheets(Worksheets.Count)
ActiveSheet.Name = sStkHldr

'get KOL, Institution
Set c = r.Cells(WorksheetFunction.Match(sStkHldr, r, 0), 1)
With c
.Offset(columnoffset:=-2).Resize(columnsize:=4).Copy _
Destination:=Worksheets(sStkHldr).Range("C1")
With Worksheets(sStkHldr).Range("C1", "F1")
.Font.Bold = True
.HorizontalAlignment = xlCenter
End With
.Offset(columnoffset:=5).Cells(1).Copy _
Destination:=Worksheets(sStkHldr).Range("C2")
With Worksheets(sStkHldr).Range("C2")
.Font.Bold = True
.HorizontalAlignment = xlCenter
End With
End With
Application.CutCopyMode = False

'see if listed as stakeholder on Field Mapping sheet
'first find rows titled "Stakeholder"
'these will be repeated every 7th row for the number of actions
' on Field Mapping sheet
With Worksheets("Field Mapping").Cells
Set r2 = .Columns(1).Find(what:="Stakeholder", after:=.Range("A1"), LookIn:=xlValues, _
lookat:=xlWhole, searchorder:=xlByRows, searchdirection:=xlNext)
Set r2 = .Range(r2, .Cells(r2.Row, .Columns.Count).End(xlToLeft))
For l = 1 To lNumActions - 1
Set r2 = Union(r2, r2.Rows(1).Offset(rowoffset:=7 * l))
Next l
End With
With r2
Set c = .Find(what:=sStkHldr, after:=r2(1), LookIn:=xlValues, _
lookat:=xlWhole, searchorder:=xlByColumns, searchdirection:=xlNext, _
MatchCase:=True)
If Not c Is Nothing Then 'At least one entry for this stakeholder
sFirstAddress = c.Address
ReDim vRes(0 To UBound(aMapping), 0 To 0)

'Labels Column
For j = 0 To UBound(aMapping)
vRes(j, 0) = aMapping(j)
Next j

Do
k = UBound(vRes, 2) + 1
ReDim Preserve vRes(0 To UBound(aMapping), 0 To k)
'Top 4 rows come from rows 4-7 on Field Mapping
With .Worksheet
For l = 0 To 3
vRes(l, k) = .Cells(l + 4, c.Column)
Next l

'will hard code relationships but, if these may change, could use .Find
For l = 4 To UBound(aMapping)
Select Case l
Case 4 To 6
vRes(l, k) = .Cells(c.Row + l - 7, c.Column)
Case Else
vRes(l, k) = .Cells(c.Row + l - 6, c.Column)
End Select
Next l
End With
Set c = .FindNext(c)
Loop While c.Address <> sFirstAddress
With Worksheets(sStkHldr).Range(Cells(9, 1), Cells(9 + UBound(vRes, 1), 1 + UBound(vRes, 2)))
.Cells = vRes

'Results Sorting Routine
'Be very careful with any changes
'presently sorts by event date only
.Worksheet.Sort.SortFields.Clear
.Worksheet.Sort.SortFields.Add Key:=.Rows(4), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
.Worksheet.Sort.SetRange .Cells.Offset(columnoffset:=1).Resize(columnsize:=.Cells.Columns.Count - 1)
With .Worksheet.Sort
.Header = xlNo
.MatchCase = False
.Orientation = xlLeftToRight
.SortMethod = xlPinYin
.Apply
End With
'End sorting routine

'Apply the various formats -- color, borders, etc here
.Columns(1).Interior.Color = 16733081
Range(.Rows(1), .Rows(4)).Interior.Color = 16733081
.Range(Cells(RowIndex:=5, columnindex:=2), Cells(RowIndex:=.Rows.Count, columnindex:=.Columns.Count)).Interior.Color = 10213316
.Cells.Font.Bold = True

'Alignment and autofit should be done last
.HorizontalAlignment = xlCenter
.EntireColumn.AutoFit
End With
End If
End With

'Number of Visits & Number of Calls
With WorksheetFunction
Range("c3") = .CountIfs([16:16], "Face to Face", [18:18], "yes")
Range("c4") = .CountIfs([16:16], "Face to Face", [18:18], "yes") + .CountIfs([16:16], "Telephone", [18:18], "yes") + .CountIfs([16:16], "Email", [18:18], "yes") + .CountIfs([16:16], "Fax", [18:18], "yes")
End With
Next i
End Sub
====================================================

 

[ulrik.hillaert]

Hello Ron,

The reason why I combine the VBA code with the template is that for someof the formulas, the target's cell layout is overwritten by the formula, which results in a terrible looking sheet. For that reason, I have put the layout-coding after the copying steps to ensure that it looks a bit reasonable.

I fully agree that it is much better to use VBA to get the stakeholders data, but I'm just not capable of generating the VBA code to do this (all the coding you see is copy-past result with minor adaptations towards layout: I simply don't understand the logic of the coding). e.g. I don't even know how to start with the find.range thing you describe (but I'm gonna try anyway ). I let it know if I get anywhere, but I do hope you somehow find the time to take a closer look at it.


PS sorry for the change of the template, the last one is really the definite one.

OK, given the accuracy of your last example, the following seems to do a lot of what you want.

Obviously, run this on a copy.

I do not use the "button code" at all, but generate and format each worksheet "on the fly".



See what you think.



If you are going to move things around on the template, or on other sheets, it may require some coding changes.



============================================

Option Explicit

Sub StakeholderWorksheets()

Dim colStakeholders As Collection

Dim wsTemplate As Worksheet

Dim wsMaster As Worksheet

Dim c As Range, r As Range, r2 As Range

Dim sStkHldr As String

Dim sFirstAddress

Dim sHospital As String

Dim vKOL As Variant, vRes() As Variant

Dim i As Long, j As Long, k As Long, l As Long

Dim lImportantActionsCount As Long

Const lNumActions As Long = 10





'Items to map to stakeholder sheet

Dim aMapping As Variant

aMapping = Array("", "Event Description", "Internal Event Lead", "Event Date", "Important Action", "Due Date", "Internal Lead", "Contact Method", "Notes", "Executed")



'get unique list of Stakeholders

'based on Last Name on Master Sheet

'If there are duplicate last names, they will be merged

'If this needs to be checked, must alter code



'Find Last Name column

Set wsMaster = Worksheets("Master")

With wsMaster.Cells

Set c = .Find(what:="Last Name*", after:=[a1], LookIn:=xlValues, _

lookat:=xlWhole, searchorder:=xlByRows, searchdirection:=xlNext, _

MatchCase:=False)

If c Is Nothing Then

MsgBox ("No Last Name column on worksheet: " & wsMaster.Name)

Exit Sub

End If



'Generate list of Unique Last Names

'could sort them if you want, otherwise will be in order as on Masster

Set r = Range(c.Offset(rowoffset:=1), .Cells(.Rows.Count, c.Column).End(xlUp))

Set colStakeholders = New Collection

On Error Resume Next

For Each c In r

If Len(Trim(c.Text)) > 0 Then colStakeholders.Add Item:=c.Text, Key:=c.Text

Next c

On Error GoTo 0



End With



'Generate worksheets for each Stakeholder

'If worksheet already present, delete it and create new one

'Will use Sjabloon but remove all the formulas

'Should probably have Sjabloon as a hidden worksheet

'or Generate this differently

Set wsTemplate = Worksheets("Sjabloon")

On Error Resume Next

wsTemplate.Cells.SpecialCells(xlCellTypeFormulas).ClearContents

On Error GoTo 0



For i = 1 To colStakeholders.Count

'Is worksheet already present?

sStkHldr = colStakeholders(i)

On Error Resume Next

Application.DisplayAlerts = False

Worksheets(sStkHldr).Delete

Application.DisplayAlerts = True

On Error GoTo 0

wsTemplate.Copy after:=Worksheets(Worksheets.Count)

ActiveSheet.Name = sStkHldr



'get KOL, Institution

Set c = r.Cells(WorksheetFunction.Match(sStkHldr, r, 0), 1)

With c

.Offset(columnoffset:=-2).Resize(columnsize:=4).Copy _

Destination:=Worksheets(sStkHldr).Range("C1")

With Worksheets(sStkHldr).Range("C1", "F1")

.Font.Bold = True

.HorizontalAlignment = xlCenter

End With

.Offset(columnoffset:=5).Cells(1).Copy _

Destination:=Worksheets(sStkHldr).Range("C2")

With Worksheets(sStkHldr).Range("C2")

.Font.Bold = True

.HorizontalAlignment = xlCenter

End With

End With

Application.CutCopyMode = False



'see if listed as stakeholder on Field Mapping sheet

'first find rows titled "Stakeholder"

'these will be repeated every 7th row for the number of actions

' on Field Mapping sheet

With Worksheets("Field Mapping").Cells

Set r2 = .Columns(1).Find(what:="Stakeholder", after:=.Range("A1"), LookIn:=xlValues, _

lookat:=xlWhole, searchorder:=xlByRows, searchdirection:=xlNext)

Set r2 = .Range(r2, .Cells(r2.Row, .Columns.Count).End(xlToLeft))

For l = 1 To lNumActions - 1

Set r2 = Union(r2, r2.Rows(1).Offset(rowoffset:=7 * l))

Next l

End With

With r2

Set c = .Find(what:=sStkHldr, after:=r2(1), LookIn:=xlValues, _

lookat:=xlWhole, searchorder:=xlByColumns, searchdirection:=xlNext, _

MatchCase:=True)

If Not c Is Nothing Then 'At least one entry for this stakeholder

sFirstAddress = c.Address

ReDim vRes(0 To UBound(aMapping), 0 To 0)



'Labels Column

For j = 0 To UBound(aMapping)

vRes(j, 0) = aMapping(j)

Next j



Do

k = UBound(vRes, 2) + 1

ReDim Preserve vRes(0 To UBound(aMapping), 0 To k)

'Top 4 rows come from rows 4-7 on Field Mapping

With .Worksheet

For l = 0 To 3

vRes(l, k) = .Cells(l + 4, c.Column)

Next l



'will hard code relationships but, if these may change, could use .Find

For l = 4 To UBound(aMapping)

Select Case l

Case 4 To 6

vRes(l, k) = .Cells(c.Row + l - 7, c.Column)

Case Else

vRes(l, k) = .Cells(c.Row + l - 6, c.Column)

End Select

Next l

End With

Set c = .FindNext(c)

Loop While c.Address <> sFirstAddress

With Worksheets(sStkHldr).Range(Cells(9, 1), Cells(9 + UBound(vRes, 1), 1 + UBound(vRes, 2)))

.Cells = vRes



'Results Sorting Routine

'Be very careful with any changes

'presently sorts by event date only

.Worksheet.Sort.SortFields.Clear

.Worksheet.Sort.SortFields.Add Key:=.Rows(4), _

SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal

.Worksheet.Sort.SetRange .Cells.Offset(columnoffset:=1).Resize(columnsize:=.Cells.Columns.Count - 1)

With .Worksheet.Sort

.Header = xlNo

.MatchCase = False

.Orientation = xlLeftToRight

.SortMethod = xlPinYin

.Apply

End With

'End sorting routine



'Apply the various formats -- color, borders, etc here

.Columns(1).Interior.Color = 16733081

Range(.Rows(1), .Rows(4)).Interior.Color = 16733081

.Range(Cells(RowIndex:=5, columnindex:=2), Cells(RowIndex:=..Rows.Count, columnindex:=.Columns.Count)).Interior.Color = 10213316

.Cells.Font.Bold = True



'Alignment and autofit should be done last

.HorizontalAlignment = xlCenter

.EntireColumn.AutoFit

End With

End If

End With



'Number of Visits & Number of Calls

With WorksheetFunction

Range("c3") = .CountIfs([16:16], "Face to Face", [18:18], "yes")

Range("c4") = .CountIfs([16:16], "Face to Face", [18:18], "yes") + ..CountIfs([16:16], "Telephone", [18:18], "yes") + .CountIfs([16:16], "Email", [18:18], "yes") + .CountIfs([16:16], "Fax", [18:18], "yes")

End With

Next i

End Sub

====================================================

You're just a genious, I just don't see how you can come up with this...
Gonna paste it into my workbook and try to understand what it does. I'll keep you informed!!!

Best regards,
Ulrik

 

[ulrik.hillaert]

Hello Ron,

I pasted the code in the spreadsheet, but I seem to run into "runtime" errors (code 400 showing up, no debugging option, only ok to choose). The macroseems to stop after the addition of the third sheet. I tried different changes, but couldn't get it to work
1) put some data in cell B8 because it's the first empty cell in that column, but didn't change anything
2) removed the three top lines from the feeld mapping sheet (since they're only name suggestions, not really necessary) but that didn't change the outcome
3) changed the stakeholders name in the planning sheet to the last name in the row (since i thought the issue might be in reading out the planning sheet) but this didn't change either.
Kinda run out of options. I'm going to try to continue, but if you can easily come up with a solution: feel welcome
Best regards,
Ulrik

 

[ulrik.hillaert]

Hello Ron,

I pasted the code in the spreadsheet, but I seem to run into "runtime" errors (code 400 showing up, no debugging option, only ok to choose). The macroseems to stop after the addition of the third sheet. I tried different changes, but couldn't get it to work
1) put some data in cell B8 because it's the first empty cell in that column, but didn't change anything
2) removed the three top lines from the feeld mapping sheet (since they're only name suggestions, not really necessary) but that didn't change the outcome
3) changed the stakeholders name in the planning sheet to the last name in the row (since i thought the issue might be in reading out the planning sheet) but this didn't change either.
Kinda run out of options. I'm going to try to continue, but if you can easily come up with a solution: feel welcome
Best regards,
Ulrik
PS no idea why that "Tribiani" line was hidden, this was definitely not meant to be like that

 

[Ron Rosenfeld]

Hello Ron,

I pasted the code in the spreadsheet, but I seem to run into "runtime" errors (code 400 showing up, no debugging option, only ok to choose). The macro seems to stop after the addition of the third sheet. I tried different changes, but couldn't get it to work
1) put some data in cell B8 because it's the first empty cell in that column, but didn't change anything
2) removed the three top lines from the feeld mapping sheet (since they're only name suggestions, not really necessary) but that didn't change the outcome
3) changed the stakeholders name in the planning sheet to the last name in the row (since i thought the issue might be in reading out the planning sheet) but this didn't change either.
Kinda run out of options. I'm going to try to continue, but if you can easily come up with a solution: feel welcome
Best regards,
Ulrik

"I pasted the code in the spreadsheet". I have no idea what that statement means.

The code needs to go into a REGULAR module. To do that:

<alt-F11> opens the Visual Basic Editor.
Ensure your project is highlighted in the Project Explorer window.
Then, from the top menu, select Insert/Module and
paste the code into the window that opens.

To use this Macro (Sub), <alt-F8> opens the macro dialog box. Select the macro by name, and <RUN>.

===============================

The code runs perfectly well using the second workbook you provided which you wrote was a "good version". If you are running it on a workbook that is not formatted similarly, I would not expect the code to work.

 

[ulrik.hillaert]

Haha, I'm delirious, this really works!!!!
I think that I've demonstrated my noob status above. What I simply did was right clicking the master sheet and choose view code and next paste everything into the master sheet....
I don't know how to thank you!!!
Best regards,
Ulrik