0

I wonder whether someone may be able to help me please.

I'm using the code below to search a named range ("ProjectName") for any cell that contains the value "OVH". When this value is found, the script creates a list of unique values from this range and pastes them into the named range "EnhancementsList"

Sub UniqueEnhancements()

Dim MyCell

 With CreateObject("scripting.dictionary")
        For Each MyCell In Range("ProjectName").Value
           If InStr(1, MyCell, "OVH") > 0 Then
               .Item(MyCell) = 1
            End If
        Next
        Range("EnhancementsList").Resize(.Count) = Application.Transpose(.keys)
    End With

    Worksheets("Enhancements").Columns("B:B").AutoFit

    Range("EnhancementsList").Sort Key1:=Range("EnhancementsList").Cells(2, 1), _
    Order1:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:=False, _
    Orientation:=xlTopToBottom, DataOption1:=xlSortNormal

End Sub

The code works fine but, I'd like if possible, to adapt this so that although it checks the "ProjectName" range for the "OVH" text string, it copies, and creates the list of unique values from the column one step to the left with the named range "Task", but I'm not sure how to do this, despite spending a couple of days trying to come up with a solution.

I have tried, with the limited knowledge I have, to change this line:

.Item(MyCell) = 1

to

.Item(MyCell.offset -1) = 1

and

.Item.offset-1 (MyCell) = 1

But I receive mismatch errors.

I just wondered whether someone could possibly take a look at this please and let me know where I'm going wrong.

Many thanks and kind regards

Community
  • 1
  • 1
IRHM
  • 1,326
  • 11
  • 77
  • 130
  • Why don't you make a new loop after the code above has completed where you iterate through the Dictionary and print each value in the column to the left? – mattboy Aug 02 '13 at 16:20
  • Another way to do this is to filter your range and copy the results. When you can use this approach, it is more efficient than looping. Take a look here for an example of how to autofilter based on similar criteria to yours: [Autofilter on part of string](http://stackoverflow.com/a/16901714/138938), and here for how to copy part of the autofiltered range: [Copy/Paste Visible Cells](http://stackoverflow.com/q/17531128/138938). – Jon Crowell Aug 02 '13 at 16:40

2 Answers2

0

The problem is that you're using .value instead of .cells for your For Each loop. So MyCell is ending up as a String, and you can't Offset from a string

Try this instead:

For Each MyCell In Range("ProjectName").Cells
   If InStr(1, MyCell.Value, "OVH") > 0 Then
      .Item(MyCell.Offset(0,-1)) = 1
   End If
Next

(Not tested)

dendarii
  • 2,958
  • 20
  • 15
  • Hi @dendarii, thank you for taking the time to reply to my post and for the proposed solution. I've tested the code, and it does copy the values from the column to the left, but unfortunately it copies duplicate values across to the destination sheet, rather than a unique value. It also seems to loop on the first set of values and fails to copy those values below. Many thanks and kind regards – IRHM Aug 02 '13 at 17:27
0

The format of Offset is

Offset([RowOffset],[ColumnOffset])

So if you are looking to get the value one column to the left of your cell, you would need to do the following

MyCell.Offset(0,-1)
Jaycal
  • 2,087
  • 1
  • 13
  • 21
  • Hi @Jaycal, thank you for taking the time to reply to my post and for the suggestion. I think I implemented this correctly, so I changed `.Item(MyCell) = 1` to `.Item(MyCell.Offset(0, -1)) = 1`. If I've done this correctly, this, unfortunately creates a Run time '42' mismatch error. Many thanks and kind regards – IRHM Aug 02 '13 at 17:30
  • is `MyCell.Offset(0, -1)` an integer value? this may be why it's throwing the error – Jaycal Aug 02 '13 at 18:24
  • Hi @Jaycal, thank you very much for coming back to me with this. I just wanted to let you know that since posting my requirements have changed and this would now be superfluous. Thank you for taking the time to help me out and all the very best. – IRHM Aug 04 '13 at 13:16