Convert excel vba to vb.net

Collapse
X
 
  • Time
  • Show
Clear All
new posts
  • aldusarugay
    New Member
    • Jun 2014
    • 4

    Convert excel vba to vb.net

    hi good day to all, i have this code to compare two excel sheets and show their differences in the 3rd sheet but the code is in vba format and i want to convert this to vb.net. i am asking for help regarding this problem. im new here and i appreciate your help thank you.

    here is the code:

    Code:
    Option Explicit
    Dim miMaxColumns As Integer
    Sub CompareSheets()
    Dim bChanged As Boolean, baChanged() As Boolean
    Dim iColEnd As Integer, iCol As Integer, iCol1 As Integer, iCol2 As Integer
    Dim lRow1 As Long, lRow2 As Long, lReportRow As Long
    Dim objDictOld As Object, objDictNew As Object
    Dim vKeys As Variant, vKey As Variant
    Dim vaInput() As Variant, vaOutput() As Variant, vaOutput2() As Variant
    Dim vaInputOld As Variant, vaInputNew As Variant
    Dim wsOld As Worksheet, wsNew As Worksheet, wsReport As Worksheet
    
    
    Set wsOld = Sheets("Sheet1")
    miMaxColumns = wsOld.Cells(1, Columns.Count).End(xlToLeft).Column
    Set objDictOld = PopulateDictionary(WS:=wsOld)
    Set wsNew = Sheets("Sheet2")
    Set objDictNew = PopulateDictionary(WS:=wsNew)
    
    Set wsReport = Sheets("Sheet3")
    
    With wsReport
        .Cells.ClearFormats
        .Cells.ClearContents
    End With
    
    wsOld.Range("A1:" & wsOld.Cells(1, miMaxColumns).Address).Copy
    wsReport.Range("B1").PasteSpecial xlPasteValues
    Application.CutCopyMode = False
    
    lReportRow = 1
    vKeys = objDictOld.Keys
    For Each vKey In vKeys
        ReDim vaInputOld(1 To 1, 1 To miMaxColumns)
        vaInputOld = objDictOld.Item(vKey)
        If objDictNew.exists(vKey) Then
            ReDim vaInputNew(1 To 1, 1 To miMaxColumns)
            vaInputNew = objDictNew.Item(vKey)
            ReDim vaOutput(1 To 1, 1 To miMaxColumns + 1)
            ReDim vaOutput2(1 To 1, 1 To miMaxColumns + 1)
            ReDim baChanged(1 To miMaxColumns)
            bChanged = False
            For iCol = 1 To miMaxColumns
                vaOutput(1, iCol + 1) = vaInputOld(1, iCol)
                If vaInputOld(1, iCol) <> vaInputNew(1, iCol) Then
                    vaOutput2(1, iCol + 1) = vaInputNew(1, iCol)
                    baChanged(iCol) = True
                    bChanged = True
                End If
            Next iCol
            If bChanged Then
                lReportRow = lReportRow + 1
                For iCol = 1 To UBound(baChanged)
                    If baChanged(iCol) Then
                        With wsReport
                            .Range(.Cells(lReportRow, iCol + 1).Address, _
                                   .Cells(lReportRow + 1, iCol + 1).Address).Interior.Color = vbYellow
                        End With
                    End If
                Next iCol
                
                vaOutput(1, 1) = "Changed"
                With wsReport
                    .Range(.Cells(lReportRow, 1).Address, _
                           .Cells(lReportRow, miMaxColumns + 1).Address).Value = vaOutput
                    lReportRow = lReportRow + 1
                    .Range(.Cells(lReportRow, 1).Address, _
                           .Cells(lReportRow, miMaxColumns + 1).Address).Value = vaOutput2
                End With
            End If
            objDictOld.Remove vKey
            objDictNew.Remove vKey
        Else
            ReDim vaOutput(1 To 1, 1 To miMaxColumns + 1)
            vaOutput(1, 1) = "Deleted"
            For iCol = 1 To miMaxColumns
                vaOutput(1, iCol + 1) = vaInputOld(1, iCol)
            Next iCol
            
            lReportRow = lReportRow + 1
            With wsReport
                .Range(.Cells(lReportRow, 1).Address, .Cells(lReportRow, miMaxColumns + 1).Address).Value = vaOutput
                '-- Set the row to light grey
                .Range(.Cells(lReportRow, 2).Address, .Cells(lReportRow, miMaxColumns + 1).Address).Interior.ColorIndex = 15
            End With
        End If
    Next vKey
    
    If objDictNew.Count <> 0 Then
        vKeys = objDictNew.Keys
        For Each vKey In vKeys
            ReDim vaOutput2(1 To 1, 1 To miMaxColumns + 1)
            vaInputNew = objDictNew.Item(vKey)
            vaOutput2(1, 1) = "Inserted"
            For iCol = 1 To miMaxColumns
                vaOutput2(1, iCol + 1) = vaInputNew(1, iCol)
            Next iCol
            lReportRow = lReportRow + 1
            With wsReport
                .Range(.Cells(lReportRow, 1).Address, .Cells(lReportRow, miMaxColumns + 1).Address).Value = vaOutput2
                '-- Set the row to light green
                .Range(.Cells(lReportRow, 2).Address, .Cells(lReportRow, miMaxColumns + 1).Address).Interior.ColorIndex = 4
            End With
        Next vKey
    End If
    
    objDictOld.RemoveAll
    Set objDictOld = Nothing
    objDictNew.RemoveAll
    Set objDictNew = Nothing
    End Sub
    Private Function PopulateDictionary(ByRef WS As Worksheet) As Object
    Dim lRowEnd As Long, lRow As Long
    Dim rCur As Range
    Dim sKey As String
    
    Set PopulateDictionary = Nothing
    Set PopulateDictionary = CreateObject("Scripting.Dictionary")
    lRowEnd = WS.Cells(Rows.Count, "A").End(xlUp).Row
    For lRow = 2 To lRowEnd
        sKey = Trim$(LCase$(CStr(WS.Range("A" & lRow).Value)))
        On Error Resume Next
        PopulateDictionary.Add key:=sKey, Item:=WS.Range(WS.Cells(lRow, 1).Address, _
                                                WS.Cells(lRow, miMaxColumns).Address).Value
        On Error GoTo 0
    Next lRow
    End Function
Working...