Announcement

Collapse
No announcement yet.

Compare Values on Column with Entire sheet and viceversa

Collapse
X
  • Filter
  • Time
  • Show
Clear All
new posts

  • Compare Values on Column with Entire sheet and viceversa



    Hello folks,

    I'm working on a reporting tool that imports a raw file and delivers the information all across the file.
    It sorts, arranges, copy and remove rows, but it basically copy/paste procedure.

    I was able to figured out the addition of new items and went all the way thru to items being removed and a tracker process.

    However I'm having difficulties with rows that are being duplicated and not properly updating (on either adding or removing process).
    I've hardcoded the worksheet.count to avoid working outside the range, but still getting issues with others sheets of the same workbook

    This is the code for the items being added, the idea behind this is that each sheet name is stored in a column of rawName then reading and cycling thru each row and each sheet, reviewing values from rawName towards the other sheets, if missing then copied and labeled as added.
    Code:
    Sub CompareNew()
    Dim rawName As Worksheet
    Dim lookIn As Range, c As Range, FoundRange As Range
    Dim lastrow As Integer, n As Integer
    Dim strName As String
    Application.ScreenUpdating = False
    
    lastrow = Range("D" & Rows.Count).End(xlUp).Row
    Set rawName = ActiveWorkbook.Sheets("NIKE-DOC-REP-DEVICE_SERVICETOCI")
    
    For Each c In rawName.Range("D2:D" & rawName.Range("D" & Rows.Count).End(xlUp).Row)
        For i = 2 To lastrow
            strName = rawName.Cells(i, 1).Value
            Set lookIn = Sheets(strName).Range("E5:E" & Sheets(strName).Range("E" & Rows.Count).End(xlUp).Row)
            Set FoundRange = lookIn.Find(what:=c.Value, lookIn:=xlFormulas, lookat:=xlWhole)
            If FoundRange Is Nothing Then
                rawName.Range("K" & i).Value = "Added"
                rawName.Range("B" & i & ":K" & i).Copy Sheets(strName).Range("C" & Rows.Count & ":L" & Rows.Count).End(xlUp).Offset(1)
            End If
        Next i
    Next c
    Application.ScreenUpdating = True
    End Sub
    This is for the items being removed, same as before, sort of reverse engineering all sheets values againts rawName, if missing then labeled as removed.

    Code:
    Sub CompareOld()
    Dim i As Variant
    Dim rawName As Worksheet
    Dim lastrow As Integer
    Dim c As Range, lookIn As Range, FoundRange As Range
    
    Application.ScreenUpdating = False
    
    Set rawName = ActiveWorkbook.Sheets("NIKE-DOC-REP-DEVICE_SERVICETOCI")
    lastrow = Range("D" & Rows.Count).End(xlUp).Row
    'ws_num = ThisWorkbook.Worksheets.Count
    
    ' First initial attempt
    
    '    For s = 4 To ws_num
    '        For Each c In Sheets(s).Range("E5:E" & Sheets(s).Range("E" & Rows.Count).End(xlUp).Row)
    '            For i = 2 To lastrow
    '                Set lookIn = rawName.Range("D2:D" & rawName.Range("D" & Rows.Count).End(xlUp).Row)
    '                Set FoundRange = lookIn.Find(what:=c.Value, lookIn:=xlFormulas, lookat:=xlWhole)
    '                If FoundRange Is Nothing Then
    '                    c.Range("L" & i).Value = "Removed"
    '                End If
    '            Next i
    '        Next c
    '    Next s
    
    For i = 4 To 8
        For Each c In Sheets(i).Range("E5:E" & Sheets(i).Range("E" & Rows.Count).End(xlUp).Row)
            For iRow = 5 To lastrow
                    Set lookIn = rawName.Range("D2:D" & rawName.Range("D" & Rows.Count).End(xlUp).Row)
                    Set FoundRange = lookIn.Find(what:=c.Value, lookIn:=xlFormulas, lookat:=xlWhole)
                    If FoundRange Is Nothing Then
                        Worksheets(i).Cells(iRow, "L").Value = "Removed"
                    End If
            Next iRow
        Next c
    Next i
    
    Application.ScreenUpdating = True
    End Sub
    And this is the comparison process that reads all L column values, copy the row and removes when required.
    Cycling thru sheets, reviewing L column values from sheets 4 to 8 that excludes rawdata and 2 more sheets.
    If any "Added" value is found the cells are copied and arranged to the tracker, and the label is cleared.
    If any "Removed" is found, then as before the information is copied and the entire row is deleted from source sheet

    Code:
    Sub TrackerUpdate()
    Dim i As Variant
    Dim lastrow As Integer
    Dim CS As Worksheet, TS As Worksheet, Current As Worksheet
    
    Application.DisplayAlerts = False
    Application.StatusBar = True
    
    Set TS = ActiveWorkbook.Sheets("Tracking Add-Delete")
    'ws_num = ThisWorkbook.Worksheets.Count
    trkr_date = Format(Date, "[$-en-US]mmmm d, yyyy;@)")
    lastrow = Range("B" & Rows.Count).End(xlUp).Row
    
    On Error Resume Next
    
    For i = 4 To 8
        For iRow = 5 To lastrow
            If Worksheets(i).Cells(iRow, "L").Value = "Added" Then
                Worksheets(i).Cells(iRow, "E").Copy Destination:=TS.Range("C" & TS.Rows.Count).End(xlUp).Offset(1)
                Worksheets(i).Cells(iRow, "D").Copy Destination:=TS.Range("D" & TS.Rows.Count).End(xlUp).Offset(1)
                Worksheets(i).Cells(iRow, "C").Copy Destination:=TS.Range("E" & TS.Rows.Count).End(xlUp).Offset(1)
                Worksheets(i).Cells(iRow, "L").Copy Destination:=TS.Range("F" & TS.Rows.Count).End(xlUp).Offset(1)
                Worksheets(i).Cells(iRow, "L").Clear
            End If
            If Worksheets(i).Cells(iRow, "L").Value = "Removed" Then
                Worksheets(i).Cells(iRow, "E").Copy Destination:=TS.Range("C" & TS.Rows.Count).End(xlUp).Offset(1)
                Worksheets(i).Cells(iRow, "D").Copy Destination:=TS.Range("D" & TS.Rows.Count).End(xlUp).Offset(1)
                Worksheets(i).Cells(iRow, "C").Copy Destination:=TS.Range("E" & TS.Rows.Count).End(xlUp).Offset(1)
                Worksheets(i).Cells(iRow, "L").Copy Destination:=TS.Range("F" & TS.Rows.Count).End(xlUp).Offset(1)
                Worksheets(i).Rows(iRow).EntireRow.Delete
            End If
            TS.Range("B" & TS.Rows.Count).End(xlUp).Offset(1).Value = trkr_date
        Next iRow
    Next i
    
    Application.StatusBar = False
    Application.DisplayAlerts = True
    End Sub
    Attached is the current work file, with dummy values on all sheets, which after I run the process that calls all subs, several rows get duplicated by the end of it.
    I know this is not rocket science, but maybe a fresh look will help me see thru the issues.



    Thanks in advance for any tip! And as always, sorry for the trouble...

  • #2
    For a more explained situacion...

    I'm working on a code that validates information on NIKE-DOC-REP-DEVICE_SERVICETOCI sheet against the other sheets.

    Basically there are three routines: the first CompareNew, starts on NIKE-DOC-REP-DEVICE_SERVICETOCI, reads A column (sheet destination) and D column value to look up on all remaining sheets of the wbook. If value not found then labeled as added.
    The second one CompareOld works against the NIKE-DOC-REP-DEVICE_SERVICETOCI sheet, meaning that will read all E values and trying to find'em on the NIKE-blablabla sheet, if not found labeled as Removed.
    The third will simply review all sheets with labels Added or Removed, and copy the reference to the Tracking sheet with some other features.

    Comment


    • #3


      Sadly I'm having a code that works partially ok, meaning that the code reads and is able to copy some of the needed rows.

      Please see code below
      Code:
      Sub CompareNew()
      Dim cellName, cellCl As Range
      Dim uF, uFS As Long
      Dim sName, ClName As String
      Dim sDevice, sImported, sTracker As Worksheet
      
      Application.ScreenUpdating = False
      
      Set sImported = Sheets("NIKE-DOC-REP-DEVICE_SERVICETOCI")
      uF = sImported.Range("A" & Rows.Count).End(xlUp).Row
      Set sTracker = Sheets("Tracking Add-Delete") 'Hoja de tracking
      uFT = sTracker.Range("B" & Rows.Count).End(xlUp).Row
      
      For Each cellName In sImported.Range("A2:A" & uF)
      sName = cellName
      ClName = cellName.Offset(, 3)
      
      Set sDevice = Worksheets(sName)
      uFS = sDevice.Range("B" & Rows.Count).End(xlUp).Row
      
      Set cl = sDevice.Range("E5:E" & uFS).Find(ClName, , , lookat:=xlWhole)
          If cl Is Nothing Then
              sDevice.Cells(uFS + 1, 2) = sDevice.Cells(uFS, 2) + 1
              sImported.Activate
              sImported.Range(Cells(cellName.Row, 2), Cells(cellName.Row, 10)).Copy sDevice.Cells(uFS + 1, 3)
              sTracker.Cells(uFT + 1, 2) = Format(Date, "[$-en-US]mmmm d, yyyy;@)") 'El codigo ya empieza a copiar informacion a la hoja de Tracking
              sImported.Cells(cellName.Row, 4).Copy sTracker.Cells(uFT + 1, 3)
              sImported.Cells(cellName.Row, 2).Copy sTracker.Cells(uFT + 1, 4)
              sImported.Cells(cellName.Row, 3).Copy sTracker.Cells(uFT + 1, 5)
              sTracker.Cells(uFT + 1, 6) = "Added"
          Else
          End If
      Next cellName
      
      Application.ScreenUpdating = True
      This code will read the rows being added from NIKE towards the rest of the workbook and add them if not present, afterwards I will copy them to the tracker sheet (Currently adding all to their respective sheet but not copying'em all to the tracker sheet)

      And below is the opposite code..

      Code:
      Sub CompareOld()
      Dim cellName, cellCl As Range
      Dim uF, uFS As Long
      Dim sName, ClName As String
      Dim sDevice, sImported, sTracker As Worksheet
      
      Application.ScreenUpdating = False
      
      wsName = Array("WAN Backbone-DC-RoutersSwitches", "Tools Servers", "Backbone Firewall", "Voice Messaging Managed Device", "NGWAN devices")
      
      For i = 0 To UBound(wsName)
          Set sDevice = Worksheets(wsName(i))
          uFS = sDevice.Range("B" & Rows.Count).End(xlUp).Row
          Set sImported = Sheets("NIKE-DOC-REP-DEVICE_SERVICETOCI")
          uF = sImported.Range("A" & Rows.Count).End(xlUp).Row
          Set sTracker = Sheets("Tracking Add-Delete")
          uFT = sTracker.Range("B" & Rows.Count).End(xlUp).Row
      
          For Each cellName In sDevice.Range("E5:E" & uFS)
              ClName = cellName
      
              Set cl = sImported.Range("E5:E" & uFS).Find(ClName, , , lookat:=xlWhole)
              If cl Is Nothing Then
                  sTracker.Activate
                  sTracker.Cells(uFT + 1, 2) = Format(Date, "[$-en-US]mmmm d, yyyy;@)")
                  sDevice.Cells(cellName.Row, 5).Copy sTracker.Cells(uFT + 1, 3)
                  sDevice.Cells(cellName.Row, 3).Copy sTracker.Cells(uFT + 1, 4)
                  sDevice.Cells(cellName.Row, 4).Copy sTracker.Cells(uFT + 1, 5)
                  sTracker.Cells(uFT + 1, 6) = "Removed"
                  sDevice.Rows(cellName.Row).EntireRow.Delete
              End If
          Next cellName
      Next i
      
      Application.ScreenUpdating = True
      
      End Sub
      This one will do it backwards, comparing the currently existing rows and if any of them is not present in NIKE sheet will remove it from its current sheet and copy to the tracker sheet. (This is almost not working at all... dunno why!)

      Comment

      Working...
      X