Excel VBA Examples
<syntaxhighlight lang="vb"> Public Sub compareTables()
' For i = 1 To 917 ' str1 = Sheets(1).Cells(i, 1) ' str1b = Trim(Left(str1, InStr(str1, " ") - 1)) ' ' For j = 1 To 964 ' str2 = Trim(Sheets(2).Cells(j, 7)) ' If Left(str2, Len(str1b)) = str1b Or Left(str1b, Len(str2)) = str2 Then ' Sheets(1).Cells(i, 6) = Sheets(2).Cells(j, 6) ' End If ' Next j ' Next i
Dim varSheetA As Variant Dim varSheetB As Variant Dim strRangeToCheck As String Dim iRow As Long Dim iCol As Long Dim iRowB As Long 'strRangeToCheck = "A1:IV65536" strRangeToCheck = "A1:Z1000"
'Loading the whole table into memory to speed up the comparition process. Excel takes a lot of time if comparing cell by cell!:
'Debug.Print Now
varSheetA = Worksheets("Postgres").Range(strRangeToCheck)
varSheetB = Worksheets("ITSM").Range(strRangeToCheck)
'Debug.Print Now
For iRow = LBound(varSheetA, 1) To UBound(varSheetA, 1)
'We search for the Row number containing the same SN on the second table:
Found = False
For iRowB = LBound(varSheetB, 1) To UBound(varSheetB, 1)
'Debug.Print LBound(varSheetB, 1); " "; UBound(varSheetB, 1)
'Debug.Print iRow; ": "; varSheetA(iRow, 4); " - "; iRowB; ": "; varSheetB(iRowB, 4)
If Trim(varSheetA(iRow, 4)) = Trim(varSheetB(iRowB, 4)) Then
Found = True
Exit For
End If
Next iRowB
If Found Then 'If the SN is found on the second table
'#######################################################################################################
'Use
Call result(iRow, 1, Trim(varSheetA(iRow, 1)) = Trim(varSheetB(iRowB, 1)), _
FlexibleUse(varSheetA(iRow, 1)) = FlexibleUse(varSheetB(iRowB, 1)))
'#######################################################################################################
'Manufacturer
Call result(iRow, 2, Trim(varSheetA(iRow, 2)) = Trim(varSheetB(iRowB, 2)), _
Flexible(varSheetA(iRow, 2)) = Flexible(varSheetB(iRowB, 2)))
'#######################################################################################################
'Model
Call result(iRow, 3, Trim(varSheetA(iRow, 3)) = Trim(varSheetB(iRowB, 3)), _
Flexible(varSheetA(iRow, 3)) = Flexible(varSheetB(iRowB, 3)))
'#######################################################################################################
'SN#
' If varSheetA(iRow, 4) = varSheetB(iRowB, 4) Then Worksheets("Postgres").Cells(iRow, 4).Interior.ColorIndex = 4
Call result(iRow, 4, Trim(varSheetA(iRow, 4)) = Trim(varSheetB(iRowB, 4)))
'#######################################################################################################
'Position /room
Call result(iRow, 5, InStr(varSheetB(iRowB, 5), ExtractElement(varSheetA(iRow, 5), 1)) > 0 And _
InStr(varSheetB(iRowB, 5), ExtractElement(varSheetA(iRow, 5), 2)) > 0, _
InStr(Flexible(varSheetB(iRowB, 5)), Flexible(ExtractElement(varSheetA(iRow, 5), 1))) > 0 And _
InStr(Flexible(varSheetB(iRowB, 5)), Flexible(ExtractElement(varSheetA(iRow, 5), 2))) > 0)
'Debug.Print ExtractElement(varSheetA(iRow, 5), 1); ExtractElement(varSheetA(iRow, 5), 2)
'Debug.Print varSheetB(iRowB, 5); "¦¦¦¦¦¦"; ExtractElement(varSheetA(iRow, 5), 1); "¦¦¦¦¦¦"; ExtractElement(varSheetA(iRow, 5), 2); "¦¦¦¦¦¦"
'#######################################################################################################
'Site
Call result(iRow, 6, InStr(varSheetA(iRow, 6), ExtractElement(varSheetB(iRowB, 6), 1)) > 0)
'#######################################################################################################
'Hostname
Call result(iRow, 7, Trim(varSheetA(iRow, 7)) = Trim(varSheetB(iRowB, 7)))
'#######################################################################################################
'IP
Call result(iRow, 8, Trim(varSheetA(iRow, 8)) = Trim(varSheetB(iRowB, 8)), _
InStr(varSheetB(iRowB, 8), ExtractElement(varSheetA(iRow, 8), 1)) > 0)
'#######################################################################################################
'Domain
Call result(iRow, 9, Trim(varSheetA(iRow, 9)) = Trim(varSheetB(iRowB, 9)), _
InStr(FlexibleDomain(varSheetB(iRowB, 9)), FlexibleDomain(ExtractElement(varSheetA(iRow, 9), 1))) > 0)
'#######################################################################################################
'RAM
Call result(iRow, 10, Trim(varSheetA(iRow, 10)) = Trim(varSheetB(iRowB, 10)), _
FlexibleRAM(varSheetB(iRowB, 10)) = Trim(varSheetA(iRow, 10)) Or _
Trim(varSheetB(iRowB, 10)) = FlexibleRAM(varSheetA(iRow, 10)))
'Debug.Print Trim(varSheetB(iRowB, 10)), FlexibleRAM(varSheetA(iRow, 10))
'#######################################################################################################
'Disk
Call result(iRow, 11, Trim(varSheetA(iRow, 11)) = Trim(varSheetB(iRowB, 11)), _
FlexibleRAM(varSheetB(iRowB, 11)) = Trim(varSheetA(iRow, 11)) Or _
Trim(varSheetB(iRowB, 11)) = FlexibleRAM(varSheetA(iRow, 11)))
'#######################################################################################################
'OS
Call result(iRow, 12, InStr(varSheetA(iRow, 12), varSheetB(iRowB, 12)) > 0 And _
InStr(varSheetA(iRow, 12), varSheetB(iRowB, 13)) > 0, _
InStr(FlexibleOS(varSheetA(iRow, 12)), FlexibleOS(varSheetB(iRowB, 12))) > 0)
'#######################################################################################################
'IsVirtual
Call result(iRow, 14, Trim(varSheetA(iRow, 14)) = Trim(varSheetB(iRowB, 14)), _
FlexibleVirtual(varSheetA(iRow, 14)) = FlexibleVirtual(varSheetB(iRowB, 14)))
'#######################################################################################################
'Contract
Call result(iRow, 15, Trim(varSheetA(iRow, 15)) = Trim(varSheetB(iRowB, 15)))
'#######################################################################################################
'#######################################################################################################
'#######################################################################################################
End If Next iRow
End Sub
'#######################################################################################################
'#######################################################################################################
'#######################################################################################################
'Support functions:
'#######################################################################################################
'Painting the background of the cell Public Sub result(iRow, iCol, result As Boolean, Optional Flexible As Boolean = False)
If result Then
Sheets(1).Cells(iRow, iCol).Interior.ColorIndex = 4 'green
Else
If Not Flexible Then
Sheets(1).Cells(iRow, iCol).Interior.ColorIndex = 3 'red
Else
Sheets(1).Cells(iRow, iCol).Interior.ColorIndex = 6 'yellow
End If
End If
End Sub
'####################################################################################################### 'Public Function FindFirstInstance(WHAT_TO_FIND As String) As Integer Const WHAT_TO_FIND As String = "test2" 'Dim ws As Excel.Worksheet 'Dim FoundCell As Excel.Range '
'Set ws = ActiveSheet 'Set FoundCell = ws.Range("A:A").Find(what:=WHAT_TO_FIND, lookat:=xlWhole) 'If Not FoundCell Is Nothing Then ' FindFirstInstance = FoundCell.Row 'Else ' FindFirstInstance = 0 'End If 'End Function
'#######################################################################################################
Function Flexible(ByVal str)
str = UCase(str) str = Replace(str, "D0", "D") str = Replace(str, "R0", "R") Flexible = str
End Function
'####################################################################################################### Function FlexibleUse(ByVal str)
str = UCase(str) str = Replace(str, "DEPLOYED", "1") str = Replace(str, "DOWN", "2") str = Replace(str, "DELETE", "2") str = Replace(str, "IN INVENTORY", "2") str = Replace(str, "OPERATIVE", "1") str = Replace(str, "DEVELOPMENT", "1") str = Replace(str, "SPARE ALLOCATED", "2") str = Replace(str, "SPARE", "2")
FlexibleUse = str
End Function
'#######################################################################################################
Function FlexibleDomain(ByVal str)
str = UCase(str) str = Replace(str, " ", "") str = Replace(str, " ", "") str = Replace(str, " ", "") str = Replace(str, " ", "") FlexibleDomain = str
End Function
'####################################################################################################### Function FlexibleRAM(ByVal str)
str = 1024 * Val(str) FlexibleRAM = Trim(str)
End Function
'####################################################################################################### Function FlexibleOS(ByVal str)
str = UCase(str) str = Replace(str, "LINUX", "") str = Replace(str, " ", "") str = Replace(str, " ", "") str = Replace(str, " ", "") str = Replace(str, " ", "") FlexibleOS = str
End Function
'#######################################################################################################
Function FlexibleVirtual(ByVal str)
str = UCase(str) str = Replace(str, """PHISICAL_COMPUTER""", "") str = Replace(str, " ", "") str = Replace(str, " ", "") str = Replace(str, " ", "") str = Replace(str, " ", "") FlexibleVirtual = str
End Function
'####################################################################################################### Function ExtractElement(ByVal str, ByVal n) ' Returns the n-th element from a string using different separators
Dim x As Variant
If Left(str, 3) = "11-" Then
str = Mid(str, 4)
'Debug.Print str
End If
'str = Replace(str, "11-", "")
str = Replace(str, ";", " ")
str = Replace(str, "-", " ")
str = Replace(str, "\n", " ")
str = Replace(str, "\t", " ")
str = Replace(str, " ", " ")
str = Replace(str, " ", " ")
str = Replace(str, " ", " ")
str = Replace(str, " ", " ")
str = Trim(str)
x = Split(str, " ")
If n > 0 And n - 1 <= UBound(x) Then
ExtractElement = x(n - 1)
Else
ExtractElement = ""
End If
End Function '####################################################################################################### </syntaxhighlight>
