0

I have the following problem:

I have to perform some task multiple times per year and the weeknumbers in which I have to do these tasks are next to a merged cell that contains the task. Now I would like to find these weeknumbers by searching for the task.

Below is the data that I'm faced with. In the first column are the merged cells and in the third column the weeknumbers are posted.

enter image description here

I'm using index match to find the values, but I can only come up with one value and I would like to find all of them.

2

2 Answers 2

1

You didn't ask for a VBA solution, but it would seem to be the easiest to implement. You also did not specify how you wanted your data to be output, nor how you wanted to be able to select the task/weeks to be displayed.

I assumed or chose the following, all of which can be changed:

  • The Tasks and Weeks would be in columns A and C as you show above
  • The relevant Task will be chosen from a cell dropdown, implemented through data validation, and that task list will be alphabetized (sorted)
  • Since your task list includes commas, we need to create the task list as a range of cells on a worksheet. This worksheet will be a hidden sheet.
  • The list will be output in a Message Box
  • The algorithm allows for duplicate Tasks in column A
  • The list of weeks returned depends critically on the merged area of the task list. If you ever UNmerge the cells, the algorithm will need adjusting.
  • The list will update whenever you make a change in the task list, or change the selected task in the dropdown box.

Worksheet Code

Right-click the Worksheet Tab and select View Code


Option Explicit
Private Sub Worksheet_Activate()
    Set rInput = Cells(1, 5)
    Application.EnableEvents = False
        ValidationList
    Application.EnableEvents = True
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
    Set rInput = Cells(1, 5)
    If Not Intersect(Target, Columns(1)) Is Nothing Then
        Application.EnableEvents = False
            ValidationList
        Application.EnableEvents = True
    End If
    If Not Intersect(Target, rInput) Is Nothing Then DisplayWeeks
End Sub

Regular Module

Select Insert Module from the Menu Bar of the VB Editor


Option Explicit
Public rInput As Range
Sub ValidationList()
    Dim colTasks As Collection
    Dim vTasks() As Variant
    Dim V1 As Variant, V2 As Variant
    Dim I As Long

'Read the tasks into a variant array
V1 = Range(Cells(2, 1), Cells(Rows.Count, 1).End(xlUp))

'Collect the tasks, eliminate the blanks
'Remove Duplicate entries

Set colTasks = New Collection

On Error Resume Next
For Each V2 In V1
    If V2 <> "" Then colTasks.Add V2, CStr(V2)
Next V2
On Error GoTo 0

'Read tasks into array
ReDim vTasks(1 To colTasks.Count)
For I = 1 To UBound(vTasks)
    vTasks(I) = colTasks(I)
Next I

'Since tasks might contain a comma
'  the list must be on a worksheet
'Create the worksheet if not present
'  and hide it
Dim wsTasks As Worksheet
Dim rTasks As Range

On Error Resume Next
    Set wsTasks = Worksheets("Tasks")
    Select Case Err.Number
        Case 9
            Worksheets.Add
            ActiveSheet.Name = "Tasks"
            Set wsTasks = Worksheets("Tasks")
            wsTasks.Visible = xlSheetHidden
        Case Is <> 0
            Debug.Print Err.Number, Err.Description
            Stop 'for debugging
            Exit Sub
    End Select
On Error GoTo 0

Set rTasks = wsTasks.Cells(1, 1).Resize(1, UBound(vTasks))
rTasks = vTasks

'Sort the task list
rTasks.Sort key1:=rTasks.Rows(1), _
            order1:=xlAscending, _
            Header:=xlNo, _
            MatchCase:=False, _
            Orientation:=xlSortRows

'Create the Input Cell
With rInput
    .Clear
    With .Validation
        .Add Type:=xlValidateList, _
         AlertStyle:=xlValidAlertInformation, _
         Formula1:="=" & rTasks.Worksheet.Name & "!" & rTasks.Address(True, True)
        .InCellDropdown = True
        .InputMessage = "Select from Drop Down List"
        .ShowInput = True
        .ShowError = True
    End With
    
    .Style = "Input"
End With
            
End Sub

Select Insert Module from the Menu Bar of the VB Editor to insert a second regular module. You could put both in the same module, but debugging may be simpler this way

If you do put both macros in the same module, remove the 2nd instance of Option Explicit


Option Explicit

Sub DisplayWeeks()
    Dim colWeeks As Collection
    Dim R1 As Range, R2 As Range, C As Range
    Dim FirstAddress As String
    Dim V As Variant, I As Long

Set colWeeks = New Collection

'Find the task(s)
If rInput = "" Then Exit Sub
With Columns(1)
    Set R1 = .Find(what:=rInput, _
        after:=.Cells(.Rows.Count), _
        LookIn:=xlValues, _
        lookat:=xlWhole, _
        searchorder:=xlByRows, _
        searchdirection:=xlNext, _
        MatchCase:=False)
    If R1 Is Nothing Then
        MsgBox "Something Wrong" & vbLf & """Find"" &  did not work"
        Stop
        Exit Sub
    End If
    
    FirstAddress = R1.Address
    Set R2 = R1.Offset(0, 2).Resize(rowsize:=R1.MergeArea.Rows.Count)
    For Each C In R2
        If C.Text <> "" Then colWeeks.Add C.Text
    Next C
    
    Do
        Set R1 = .FindNext(R1)
            If R1 Is Nothing Then Exit Do
        If R1.Address <> FirstAddress Then
            Set R2 = R1.Offset(0, 2).Resize(rowsize:=R1.MergeArea.Rows.Count)
            For Each C In R2
                If C.Text <> "" Then colWeeks.Add C.Text
            Next C
        End If
    Loop Until R1.Address = FirstAddress
End With

ReDim V(1 To colWeeks.Count)
For I = 1 To UBound(V)
    V(I) = CStr(colWeeks(I))
Next I

Application.Cursor = xlDefault
MsgBox "Weeks for this task:" & vbLf & Join(V, vbLf)

End Sub
-2

Is there a reason why you couldn't use .Next? For example, if you select one of the cells with a task in it, Selection.Next.Next.Text will grab the text of the cell two columns over, or Selection.Next.Next.Value will grab the value of that cell instead. (If you're not directly selecting the task, you can apply .Next.Next.Text or .Next.Next.Value programmatically.)

11
  • any reason for the down vote?
    – freginold
    Dec 23, 2016 at 13:57
  • Downvote wasn't me, but could you give an example of actual usage of this approach? I've never seen it before and can't find anything online (probably because of the common nature of the word "next").
    – 3N1GM4
    Dec 23, 2016 at 14:02
  • @3N1GM4 sure, say for example you have the word "test" in cell D3. If you run the command MsgBox Selection.Next.Next.Text in a macro while B3 is the selected cell, the message box will display "test"
    – freginold
    Dec 23, 2016 at 14:08
  • could be used to change values, like if you type a certain key word or value into one cell and because of that, want a different, corresponding cell to display a different value
    – freginold
    Dec 23, 2016 at 14:10
  • 1
    I think you might not have fully understood the question, as I believe the OP has already got that far using formulas. What you're suggesting would allow the lookup of the value 1-2 based on an input of natte kant PM, but the OP wants to also fetch the values 21-22 and 41-42 from this one input, as those values all sit in cells adjacent to the merged cell in A2, which covers the range A2:A6.
    – 3N1GM4
    Dec 23, 2016 at 14:13

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.