VBA to VB.NET conversion trouble

Sep 16, 2013 at 3:59 PM
Edited Sep 16, 2013 at 4:00 PM
I have a VBA routine that highlights all duplicate cells in a given 1 coumn range.

I converted this to VB.NET and I am getting stuck on the following line:
rngObj = XlCall.Excel(XlCall.xlfCaller)

I get a message "mso.pdb not loaded. mso.pdb contains the debug information required to find the source for the module MSO.DLL" and the debugger suggests me to load the file from different locations.

What am I doing wrong here?

Ismail
    Sub Find_Duplicate_Entry()
        Dim dummy As Excel.Application
        dummy = New Excel.Application(Nothing, ExcelDnaUtil.Application)
        'Dim ws As Excel.Worksheet
        Dim cel As Object
        Dim clr As Long
        Dim rngObj As Object
        rngObj = XlCall.Excel(XlCall.xlfCaller)
        Dim rng As ExcelReference = DirectCast(rngObj, ExcelReference)
        Dim UserRange As Excel.Range = ReferenceToRange(rng)

        If UserRange.Columns.Count > 1 Then
            MsgBox("This tool was written for a single column. Please select one column only.", vbExclamation + vbOKOnly)
            Exit Sub
        End If
        UserRange.Interior.ColorIndex = XlColorIndex.xlColorIndexNone
        clr = 3
        For Each cel In UserRange
            If dummy.WorksheetFunction.CountIf(UserRange, cel) > 1 Then
                If dummy.WorksheetFunction.CountIf(dummy.Range("C2:C" & cel.Row), cel) = 1 Then
                    cel.Interior.ColorIndex = clr
                    clr = clr + 1
                Else
                    cel.Interior.ColorIndex = UserRange.Cells(dummy.WorksheetFunction.Match(cel.Value, UserRange, False), 1).Interior.ColorIndex
                End If
            End If
        Next
    End Sub
    Private Shared Function ReferenceToRange(xlref As ExcelReference) As Object
        Dim strAddress As String = XlCall.Excel(XlCall.xlfReftext, xlref, True)
        ReferenceToRange = ExcelDnaUtil.Application.range(strAddress)
    End Function
Coordinator
Sep 16, 2013 at 6:55 PM
Edited Sep 16, 2013 at 8:30 PM
Hi Ismail,

There are some issues with your code:
  • I'm not sure why you need the New Application(...) - you can directly use the result of ExcelDnaUtil.Application as the right Application object for your add-in.
  • Your macro will likely be run from a ribbon button, so it's not clear what you mean by the 'Caller'.
  • You are calling the Excel C API (the XlCall.Excel call) but since you are using COM here (the Application object) you would rather just use that directly. Application.Caller would work, or whatever you had in the VBA code.
  • You probably want Application.Selection... and then check that it is a Range object?
I can't say about the strange debug message - I've not seen anything like that.

Regards,
Govert
Sep 16, 2013 at 8:16 PM
Sorry for the confusion Govert.

I have a complex addin that is using COM, ExcelDNA, and NetOffice and I guess I started mixing up all my objects and variables :)

Yes, the macro is being called from my ribbon and I should really use ExcelDNAUtil.Application to get the right object. The Caller code was because I was thinking that I was using a function and passing a range, which was entirely different, and it was wrong. And yes you're also right by saying that Application.Selection should work... and indeed it works.

Here's what my final sub looks like; it works as expected.
I am pasting it below so someone might find it useful.
I also included the VBA version of it so they can see the differences.

Thanks for your quick response.

Ismail
    Sub Find_Duplicate_Entry()
        Dim myApp As Object = ExcelDnaUtil.Application
        Dim cel As Object
        Dim clr As Long
        Dim UserRange As Object = myApp.selection
        Dim rowNumber As Long
        Dim address1, address2 As String
        If UserRange.Columns.Count > 1 Then
            MsgBox("This tool was written for a single column. Please select one column only.", vbExclamation + vbOKOnly)
            Exit Sub
        End If
        UserRange.Interior.ColorIndex = XlColorIndex.xlColorIndexNone
        clr = 3
        address1 = UserRange.Cells(1, 1).Address
        For Each cel In UserRange
            If myApp.WorksheetFunction.CountIf(UserRange, cel) > 1 Then
                rowNumber = cel.Row
                address1 = UserRange.Cells(1, 1).Address
                address2 = UserRange.Cells(rowNumber, 1).Address
                If myApp.WorksheetFunction.CountIf(myApp.Range(address1, address2), cel) = 1 Then
                    cel.Interior.ColorIndex = clr
                    clr = clr + 1
                Else
                    cel.Interior.ColorIndex = UserRange.Cells(myApp.WorksheetFunction.Match(cel.Value, UserRange, False), 1).Interior.ColorIndex
                End If
            End If
        Next
    End Sub
VBA:
Sub Find_Duplicate_Entry()
Dim UserRange As Range
Set UserRange = Application.InputBox(Prompt:="Please Select the Range where you'd like to Remove Duplicates", Title:="Range Select", Type:=8)
If UserRange.Columns.Count > 1 Then
    MsgBox "This macro was written for a single column. Please select one column only.", vbExclamation + vbOKOnly
    Exit Sub
End If
Dim cel As Variant
Dim myrng As Range
Dim clr As Long
Set myrng = UserRange
Dim rowNumber As Integer
Dim address1 As String, address2 As String
myrng.Interior.ColorIndex = xlNone
clr = 3
address1 = UserRange.Cells(1, 1).Address
For Each cel In myrng
    If Application.WorksheetFunction.CountIf(myrng, cel) > 1 Then
        rowNumber = cel.Row
        address2 = myrng.Cells(rowNumber, 1).Address
        If WorksheetFunction.CountIf(Range(address1, address2), cel) = 1 Then
            cel.Interior.ColorIndex = clr
            clr = clr + 1
        Else
            cel.Interior.ColorIndex = myrng.Cells(WorksheetFunction.Match(cel.Value, myrng, False), 1).Interior.ColorIndex
        End If
    End If
Next
End Sub