0

I have written code to go through two columns, one will be the key and the other item/items. It goes through and finds the keys, if it finds a duplicate it adds it to the items along with the previous item. The problem comes when I try to print out the items. The keys print out fine but the items give me the run-time error '13' type mismatch.

Here is the code.

Sub All()
Worksheets("All").Activate
Dim Server As Variant
Dim Application As Variant
Dim colLength As Variant
Dim dict As Object
Dim element As Variant
Dim counter As Integer
Dim env As Variant
Dim envLength
Dim com As Variant
Dim comLength
Dim kw As Variant
Dim kwLength

'copies pair of columns
env = Range("A3:B" & WorksheetFunction.CountA(Columns(1)) + 1).Value
com = Range("D3:E" & WorksheetFunction.CountA(Columns(4)) + 1).Value
kw = Range("G3:H" & WorksheetFunction.CountA(Columns(7)) + 1).Value
'sets the start or end point of the pasted pair of columns
envLength = WorksheetFunction.CountA(Columns(1)) + 1
comLength = envLength + WorksheetFunction.CountA(Columns(4)) + 1
kwLength = comLength + WorksheetFunction.CountA(Columns(7)) + 1
'pastes the copies in two big columns
ActiveSheet.Range("I3:J" & envLength) = env
ActiveSheet.Range("I" & (envLength) & ":J" & comLength - 3) = com
ActiveSheet.Range("I" & (comLength - 3) & ":J" & kwLength - 6) = kw

Set dict = Nothing
Set dict = CreateObject("scripting.dictionary")
colLength = WorksheetFunction.CountA(Columns(9)) + 2
counter = 1
Application = Range("I3:I" & colLength).Value
Server = Range("J3:J" & colLength)
'Generate unique list and count
For Each element In Server
    If dict.Exists(element) Then
        dict.Item(element) = dict.Item(element) & ", " & Application(counter, 1)
    Else
        dict.Add element, Application(counter, 1)
    End If
    counter = counter + 1
Next
Worksheets("All2").Activate
ActiveSheet.Range("B2:B" & dict.Count + 1).Value = WorksheetFunction.Transpose(dict.keys)
ActiveSheet.Range("A2:A" & dict.Count + 1).Value = WorksheetFunction.Transpose(dict.items)
End Sub

Error is on line before End Sub

PIPetro
  • 1
  • 4
  • What does `Application(counter,1)` do? I get an error trying to execute this sort of statement in the Immediate window; 'wrong number of arguments or invalid property assignment`. Have you debugged to ensure that your `dict.Items` actually contains any values? Declare another variably `Dim testVar as Variant` and then do `testVar = dict.Items` and debug that in the Locals window to make sure it is not empty? – David Zemens Jul 09 '13 at 13:55
  • I confirm I get a `Type 13 Mismatch` error if I try to use `WorksheetFunction.Transpose` on an empty array. – David Zemens Jul 09 '13 at 14:04
  • 1
    I'm not sure it's the issue, but you really shouldn't be using Application as a variable name, using reserved words as variables leads to all kinds oftrouble – SWa Jul 09 '13 at 15:17
  • I looked through the Locals window and it does have values and I changed all of the "Application" names to "App" – PIPetro Jul 09 '13 at 16:13

1 Answers1

0

I found that when using Transpose you can only have maximum of 255 characters in the cell. I solved this problem by creating a variable and setting it equal to the items and looping through each and copying to the sheet.

Sub Unique()
Worksheets("All").Activate
Dim Server As Variant
Dim App As Variant
Dim colLength As Variant
Dim dict As Object
Dim element As Variant
Dim counter As Integer
Dim env As Variant
Dim envLength
Dim com As Variant
Dim comLength
Dim kw As Variant
Dim kwLength
Dim dictItems As Variant

'copies pair of columns
env = Range("A3:B" & WorksheetFunction.CountA(Columns(1)) + 1).Value
com = Range("D3:E" & WorksheetFunction.CountA(Columns(4)) + 1).Value
kw = Range("G3:H" & WorksheetFunction.CountA(Columns(7)) + 1).Value
'sets the start or end point of the pasted pair of columns
envLength = WorksheetFunction.CountA(Columns(1)) + 1
comLength = envLength + WorksheetFunction.CountA(Columns(4)) + 1
kwLength = comLength + WorksheetFunction.CountA(Columns(7)) + 1
'pastes the copies in two big columns
ActiveSheet.Range("I3:J" & envLength) = env
ActiveSheet.Range("I" & (envLength) & ":J" & comLength - 3) = com
ActiveSheet.Range("I" & (comLength - 3) & ":J" & kwLength - 6) = kw

Set dict = Nothing
Set dict = CreateObject("scripting.dictionary")
colLength = WorksheetFunction.CountA(Columns(9)) + 2
counter = 1
App = Range("I3:I" & colLength).Value
Server = Range("J3:J" & colLength).Value


'Generate unique list of apps and servers
For Each element In Server
    If dict.Exists(element) Then
        If InStr(LCase(dict.item(element)), LCase(App(counter, 1))) = 0 Then
            dict.item(element) = dict.item(element) & vbLf & App(counter, 1)
        End If
    Else
        dict.Add element, App(counter, 1)
    End If
    counter = counter + 1
Next

Worksheets("All_Compare").Activate
ActiveSheet.Range("B2:B" & dict.Count + 1) = WorksheetFunction.Transpose(dict.keys)
dictItems = dict.items
For i = 0 To dict.Count - 1
    Cells(i + 2, 1) = dictItems(i)
Next

End Sub

PIPetro
  • 1
  • 4