• Status: Solved
  • Priority: Low
  • Security: Public
  • Views: 57
  • Last Modified:

modification to Rgonzo's VBA earlier post

I had this question after viewing Vba to search in column B and if unique value is just one then return it to cell A1 of sheet1.


this code

gives error on .  if there one unqiue value in column B starting from B2 then it should return that unique value in Cell A1 of Sheet1

currenty it gives error.  runtime 13 sh1.Range("A1").Resize(UBound(aDict) + 1) = Application.Transpose(aDict)

Sub macro2()
Set objDict = CreateObject("Scripting.Dictionary")
Set sh1 = Sheets(1)
Set sh2 = Sheets(2)
Set Rng = Range(sh2.Range("B2"), sh2.Range("B" & Rows.Count).End(xlUp))
For Each c In Rng
    If WorksheetFunction.CountIf(Rng, c.Value) = 1 Then
        objDict.Add c.Value, c.Value
    End If
Next

aDict = objDict.Items
sh1.Range("A1").Resize(UBound(aDict) + 1) = Application.Transpose(aDict)
End Sub

Open in new window

0
Flora
Asked:
Flora
  • 4
  • 3
1 Solution
 
Rgonzo1971Commented:
Hi,

pls try
Sub macro()
Set objDict = CreateObject("Scripting.Dictionary")
Set sh1 = Sheets(1)
Set sh2 = Sheets(2)
Set Rng = Range(sh2.Range("B2"), sh2.Range("B" & Rows.Count).End(xlUp))
For Each c In Rng
    If WorksheetFunction.CountIf(Rng, c.Value) = 1 Then
        objDict.Add c.Value, c.Value
    End If
Next
If objDict.Count > 1 Then
aDict = objDict.items
sh1.Range("A1").Resize(UBound(aDict) + 1) = Application.Transpose(aDict)
Else
aDict = objDict.items
sh1.Range("A1").Value = aDict(0)
End If
End Sub

Open in new window

Regards
1
 
FloraAuthor Commented:
getting error.

EE.png
0
 
FloraAuthor Commented:
subscript out of range.  while my sheet(1) exist.
0
Ultimate Tool Kit for Technology Solution Provider

Broken down into practical pointers and step-by-step instructions, the IT Service Excellence Tool Kit delivers expert advice for technology solution providers. Get your free copy now.

 
Rgonzo1971Commented:
Could you send a dummy?
0
 
FloraAuthor Commented:
please see attached two dummy file.

one of the file is where column B only has one unique string

second example is where COlumn B has multiple unique string
Example-with-Multiple-Unique-value.xlsb
Example-with-One-Unique-value.xlsb
0
 
Rgonzo1971Commented:
then try
Sub macro()
Set objDict = CreateObject("Scripting.Dictionary")
Set sh1 = Sheets(1)
Set sh2 = Sheets(2)
For Each c In Range(sh2.Range("B2"), sh2.Range("B" & Rows.Count).End(xlUp))
    If Not objDict.Exists(c.Value) Then objDict.Add c.Value, c.Value
Next

aDict = objDict.Items
sh1.Range("A1").Resize(UBound(aDict) + 1) = Application.Transpose(aDict)
End Sub

Open in new window

1
 
FloraAuthor Commented:
thanks very much. i love the best of use of dictionary script you have used to solve the problem. it is  very fast.
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

Join & Write a Comment

Featured Post

Ultimate Tool Kit for Technology Solution Provider

Broken down into practical pointers and step-by-step instructions, the IT Service Excellence Tool Kit delivers expert advice for technology solution providers. Get your free copy now.

  • 4
  • 3
Tackle projects and never again get stuck behind a technical roadblock.
Join Now