Excel VBA Compare two worksheets and output certain cells to a new one

cellscompareexcelrangevbscript

I've been trying for a few hours to do this, but not being an expert in excel of VBScript, I think I need a little help.

Here's what I'm up against. I have 2 different worksheets that contain some of the same information.

WORKSHEET1
Section/Dept    City    Building    SVD User Name   Item Short Code Item Full Name      SUPPLIER_SC Serial Number       IP Address  Product Class   Product     Item Status
BT&IT-         WINNIPEG GATEWAY CO  IT NETWORK      CHK0639V1JX     07JACM401093000MSYS000  CISCO   WNPIMBTVBBN-DSTH    1.2.3.4     SWITCHES       3550-24       ACTIVE

WORKSHEET2
Hostname           Management IP    Device Type        Vendor   Model           Software Version    Serial Number   Location    In Site
wnpimbtvbbn-dsth    1.2.3.4          Cisco IOS Switch   Cisco   catalyst355024  12.1(11)EA1        CHK0639V1JX     Gateway CO   Entire Network\Winnipeg\MTS TV Head End\

What I'm trying to do is correlate the two and output to a third in order to reorganize the information for import into a database. Basically, if the "Hostname" form WORKSHEET2 is found in either of "Item Short Code/Item Full Name/Serial" in WORKSHEET1, I want to output "sheet1.item short code" and then the whole row from SHEET2 but in a different order. Also, if a match isn't found, then output the whole row from SHEET2…

This is about as far as I've gotten:

Sub CompareandOutput()
    Dim inv1 As Range
    Dim Assyst1 As Range
    Dim Assyst2 As Range
    Dim Assyst3 As Range
    Dim Inventory1Items As Range
    Dim Assyst1Items As Range
    Dim Assyst2Items As Range
    Dim Assyst3Items As Range
    Sheet3.Cells.Clear


    Set Inventory1Items = Sheet2.Range("A2", Sheet2.Range("A65536").End(xlUp))
    Set Assyst1Items = Sheet1.Range("E4", Sheet1.Range("E65536").End(xlUp))
    Set Assyst2Items = Sheet1.Range("F4", Sheet1.Range("F65536").End(xlUp))
    Set Assyst3Items = Sheet1.Range("H4", Sheet1.Range("H65536").End(xlUp))

    Sheet3.Range("A1") = "Old Short Code"
    Sheet3.Range("B1") = "New Short Code"
    Sheet3.Range("C1") = "New Full Name"
    Sheet3.Range("D1") = "Serial Number"
    Sheet3.Range("E1") = "Version"
    Sheet3.Range("F1") = "IP Address"
    Sheet3.Range("G1") = "Supplier"
    Sheet3.Range("H1") = "Product Class"
    Sheet3.Range("I1") = "Product"
    For Each inv1 In Inventory1Items
        Sheet3.Range("B65536").End(xlUp).Offset(1, 0) = inv1.Value
        Set Assyst1 = Assyst1Items.Find(inv1, LookIn:=xlValues, lookat:=xlWhole)
        If Not Assyst1 Is Nothing Then
        Sheet3.Range("A65536").End(xlUp).Offset(0, 0) = Cells(Assyst1.Row, "E")
        Sheet3.Range("C65536").End(xlUp).Offset(0, 0) = inv1.Value
        'Sheet3.Range("D65536").End(xlUp).Offset(1, 0) = Sheet2(Cells(Assyst1.Row, "D")).Select
        End If
        'Set Assyst2 = Assyst2Items.Find(inv1, LookIn:=xlValues, lookat:=xlWhole)
        'If Not Assyst2 Is Nothing Then
        'Sheet3.Range("B65536").End(xlUp).Offset(1, 0) = inv1.Row
        'End If
        'Set Assyst3 = Assyst3Items.Find(inv1, LookIn:=xlValues, lookat:=xlWhole)
        'If Not Assyst3 Is Nothing Then
        'Sheet3.Range("B65536").End(xlUp).Offset(1, 0) = inv1.Row
        'End If
    Next inv1


End Sub

I'm sure I'm WAAAY off track here and there's a much simpler way to do this. Any help would REALLY be appreciated.

OK Yup… still need help. Made significant progress, but just have one last tiny little thing that's not working. Basically I can't for the life of me get the function CheckForMatch, to pass it's result "itemShortCode" to the private sub "exporttonewworksheet". Everything works up until the function ends, main sub and export subs don't seem to be getting the values. I'm sure I'm not understanding something fundemental here… 

Public Enum Assyst1Columns
    Section_Dept = 1
    City
    Building
    SVD_User_Name
    Item_Short_Code
    Item_Full_Name
    SUPPLIER_SC
    Serial_Number
    IP_Address
    Product_Class
    Product
    Item_Status
End Enum

Public Enum Inventory1Columns
    Hostname = 1
    Management_IP
    Device_Type
    Vendor
    Model
    Software_Version
    Serial_Number
    Location
    In_Site
End Enum
Public Sub main()
    Dim Assyst As Excel.Worksheet
    Dim Inventory As Excel.Worksheet
    Dim Output As Excel.Worksheet
    Set Assyst = ThisWorkbook.Worksheets("Assyst")
    Set Inventory = ThisWorkbook.Worksheets("Inventory")
    Dim InventoryItems As Range
    Sheet3.Cells.Clear

    'Set Output1 = ThisWorkbook.Worksheets.Add

    'Output1.Name = "Output1"

    Dim newWkRow As Long
    newWkRow = 1


    Dim test As String
    Set InventoryItems = Inventory.Range("A2", Inventory.Range("A65536").End(xlUp))
    ' loop through wk2
    For Each hname In InventoryItems
        ' for each wk2.Cell found, call checkForMatch()
        ' store checkForMatch() value into variable
        itemShortCode = checkForMatch(hname, Assyst)
        'Sheet3.Range("A65536").End(xlUp).Offset(1, 0) = hname
        ' export to new worksheet
        test = itemShortCode

        exportToNewWorksheet Output, Inventory, hname.Row, newWkRow, itemShortCode

        newWkRow = newWkRow + 1 ' the only reason for newWkRow is if you want to skip any
                                ' entries from WORKSHEET2. So it's best to keep this count separate
                                ' from your current loop row

    Next
End Sub

Private Function checkForMatch(ByVal hname As String, ByRef Assyst As Excel.Worksheet) As String
    ' PLEASE NOTE: wk1 does NOT need to match in the function definition to that of the
    '               variable defined in main()
    ' search for match from Inventory to Assyst
    Dim item As String
    Dim test As String
    Dim matches As String
    Dim Assyst1Items As Range
    Set Assyst1Items = Assyst.Range("A4", Assyst.Range("L65536").End(xlUp))

    On Error Resume Next
    matches = Assyst1Items.Find(hname, LookIn:=xlValues, lookat:=xlWhole)

    ' if found, return the Item_Short_Code
    If Not matches = "" Then
        item = matches
    ' otherwise return vbNullString
    Else
        item = vbNullString
    End If
    itemShortCode = item
End Function

Private Sub exportToNewWorksheet(ByRef Output As Excel.Worksheet, _
                                ByRef Inventory As Excel.Worksheet, _
                                ByRef hname As Long, _
                                ByVal newWkRow As Long, _
                                Optional ByVal itemShortCode As String = vbNullString)

    ' put data into new row. be sure to use the Enum to re-order the column as you like
    If itemShortCode = "" Then
        Sheet3.Cells(newWkRow, 2).Value = Inventory.Cells(hname, Inventory1Columns.Hostname).Value
        Sheet3.Cells(newWkRow, 3).Value = Inventory.Cells(hname, Inventory1Columns.Hostname).Value
        Sheet3.Cells(newWkRow, 4).Value = Inventory.Cells(hname, Inventory1Columns.Management_IP).Value
        Sheet3.Cells(newWkRow, 5).Value = Inventory.Cells(hname, Inventory1Columns.Device_Type).Value
        Sheet3.Cells(newWkRow, 6).Value = Inventory.Cells(hname, Inventory1Columns.Vendor).Value
        Sheet3.Cells(newWkRow, 7).Value = Inventory.Cells(hname, Inventory1Columns.Model).Value
        Sheet3.Cells(newWkRow, 8).Value = Inventory.Cells(hname, Inventory1Columns.Software_Version).Value
        Sheet3.Cells(newWkRow, 9).Value = Inventory.Cells(hname, Inventory1Columns.Serial_Number).Value
    Else
        ' store data another way
        Sheet3.Cells(newWkRow, 1).Value = Assyst.Cells(hname, Assyst1Columns.Item_Short_Code).Value
        Sheet3.Cells(newWkRow, 2).Value = Inventory.Cells(hname, Inventory1Columns.Hostname).Value
        Sheet3.Cells(newWkRow, 3).Value = Inventory.Cells(hname, Inventory1Columns.Hostname).Value
        Sheet3.Cells(newWkRow, 4).Value = Inventory.Cells(hname, Inventory1Columns.Management_IP).Value
        Sheet3.Cells(newWkRow, 5).Value = Inventory.Cells(hname, Inventory1Columns.Device_Type).Value
        Sheet3.Cells(newWkRow, 6).Value = Inventory.Cells(hname, Inventory1Columns.Vendor).Value
        Sheet3.Cells(newWkRow, 7).Value = Inventory.Cells(hname, Inventory1Columns.Model).Value
        Sheet3.Cells(newWkRow, 8).Value = Inventory.Cells(hname, Inventory1Columns.Software_Version).Value
        Sheet3.Cells(newWkRow, 9).Value = Inventory.Cells(hname, Inventory1Columns.Serial_Number).Value
        ' etc...
    End If
End Sub

Best Answer

I doubt there is a simple way to do this. From what I understand, you want to try to match a value in one worksheet in 3 possible columns in another worksheet and then output certain data from both worksheets to a new worksheet. I really don't see a clever, easy way to do this.

However, here are some suggestions. And forgive me for stating items you already know, as it seams you do know how to program:

Make use of Enum to find and re-order the copied data

Example:

Public Enum wks1Columns
    Section_Dept = 1
    City
    Building
    SVD_User_Name
    Item_Short_Code
    etc
End Enum

Public Enum wks2Columns
    Hostname = 1
    Management_IP
    Device_Type
    etc
End Enum

Public Sub test()
    Dim wk1 As Excel.Worksheet
    Dim wk2 As Excel.Worksheet
    Set wk1 = ThisWorkbook.Worksheets("WORKSHEET1")
    Set wk2 = ThisWorkbook.Worksheets("WORKSHEET2")

    ' imagine Building is in column 5 in WORKSHEET1 and SVD is in column 7 in WORKSHEET1
    ' but you wanted to put them in columns 1 and 2 in the new worksheet
    Sheet1.Cells(1, 1).Value = wk1.Cells(1, wks1Columns.Building).Value
    Sheet1.Cells(1, 2).Value = wk1.Cells(1, wks1Columns.SVD_User_Name).Value

    ' and you wanted stuff from WORKSHEET2 in the same row
    Sheet1.Cells(1, 3).Value = wk2.Cells(1, wks2Columns.Hostname).Value
End Sub

Using enums, you can store how the columns are already setup in the worksheets, then later use them to EASILY re-order a new sheet using the enum method. The cool thing is, if the WORKSHEET1 column for Section Dept ever moves to column 2 and City to column 1, you just need to re-order the enum and BOOM, you're done modifying your code ;)

Break your function up into smaller tasks

This is definitely a complicated task that you're trying to do and would be way too difficult working with if you put this all in one big Sub. Something like:

Public Sub main()
    Dim wk1 As Excel.Worksheet
    Dim wk2 As Excel.Worksheet
    Dim wkNew As Excel.Worksheet
    Set wk1 = ThisWorkbook.Worksheets("WORKSHEET1")
    Set wk2 = ThisWorkbook.Worksheets("WORKSHEET2")
    Set wkNew = ThisWorkbook.Worksheets.Add

    wkNew.Name = "My New Worksheet"

    Dim newWkRow As Long
    newWkRow = 1

    Dim itemShortCode As String

    ' loop through wk2
    ' for each wk2.Cell found, call checkForMatch()
        ' store checkForMatch() value into variable
        itemShortCode = checkForMatch("my value", wk1)

        ' export to new worksheet
        exportToNewWorksheet wkNew, wk2, currentRowFromLoop, newWkRow, itemShortCode

        newWkRow = newWkRow + 1 ' the only reason for newWkRow is if you want to skip any
                                ' entries from WORKSHEET2. So it's best to keep this count separate
                                ' from your current loop row

    ' next
End Sub

Private Function checkForMatch(ByRef theValue As String, ByRef wk1 As Excel.Worksheet) As String
    ' PLEASE NOTE: wk1 does NOT need to match in the function definition to that of the
    '               variable defined in main()


    ' search for match from wk2 to wk1


    ' if found, return the Item_Short_Code
    ' otherwise return vbNullString

End Function

Private Sub exportToNewWorksheet(ByRef newWs As Excel.Worksheet, _
                                ByRef wk2 As Excel.Worksheet, _
                                ByRef wk2Row As Long, _
                                ByVal newRow As Long, _
                                Optional ByVal Item_Short_Code As String = vbNullString)

    ' put data into new row. be sure to use the Enum to re-order the column as you like
    If (Item_Short_Code <> vbNullString) Then
        ' store data one way
        ' ...
    Else
        ' store data another way
        newWs.Cells(newRow, 1).Value = Item_Short_Code
        newWs.Cells(newRow, 2).Value = wk2.Cells(wk2Row, wks2Columns.Hostname).Value
        ' etc...
    End If
End Sub

I think you might be getting caught up in the syntax of it all. Some tips from what I see in your code:

  1. Fully qualify your range objects. The Cell object always refers to the active sheet's cell and it won't help you if you run the code from another sheet that you didn't mean to.
  2. Offset(0,0) doesn't do anything. Just use .Value if you want to set a value of a range
  3. If your main sheet has the same last row for all columns, you can just store the last row into a variable and use that in subsequent Range sets
  4. I think you have programmed before and if so, you would fly right through some VBA tutorials found online. It's worth the effort, even if you have a tight deadline.

Hope this helps

Related Topic