none
[Excel + VBA] Show related columns to duplicate values in a ListBox RRS feed

  • Question

  • Hi everyone,

    I use this code to show duplicate values from Source Column (A) into Column (F):

    Option Explicit
    
    Sub Check_Records()
    
        Dim rfound As Range, rngSearch As Range, sFind As String, lastrow As Long, lngCount As Long
        
        lastrow = Cells(Rows.Count, "F").End(xlUp).Row
        
        If Len(Range("A1").Value) < 1 Then
            MsgBox "No search criteria entered - - cancelling", vbExclamation
            Exit Sub
        End If
        
        Application.ScreenUpdating = False
        
        sFind = Range("A1").Value
        
        Set rngSearch = Range("F1:F" & lastrow)
        
        lngCount = Application.WorksheetFunction.CountIf(rngSearch, sFind)
        
        If lngCount >= 1 Then
            MsgBox "Duplicate Record", vbInformation
            Exit Sub
        Else
            Range("F" & lastrow + 1) = sFind
            MsgBox "Added new record", vbInformation
        End If
        
        Application.ScreenUpdating = True
        
        Set rngSearch = Nothing
    
    End Sub

    I want to tweak it a little bit to do this:

    Input sheet1.Cell("A1") and Data Column that may contain duplicate values sheet2.("F")

    If there is a match of duplicate then show related info in sheet2.Column("E") in a ListBox

    Regards


    • Edited by Admin-Dev Sunday, October 21, 2012 7:26 PM
    Sunday, October 21, 2012 7:25 PM

Answers

  • Hi Admin-Dev,

    I suppose you have a ListBox which named ListBox1 in a UserForm.

    Following code will do:

    Private Sub UserForm_Initialize()
        Dim xlWB As Workbook
        Dim xlWS As Worksheet
        Dim xlV As String
        Dim xlWS1 As Worksheet
        Dim iEnd As Integer
        Dim i As Integer
                
        Set xlWB = Application.ActiveWorkbook
        Set xlWS = xlWB.Sheets("Sheet1")
        xlV = xlWS.Range("A1").Value
        Set xlWS1 = xlWB.Sheets("Sheet2")
        iEnd = xlWS1.Cells.SpecialCells(xlCellTypeLastCell).Row
        For i = 2 To iEnd
            If xlV = xlWS1.Cells(i, 6).Value Then
                'please modify here to collect the value which your want
                ListBox1.AddItem xlWS1.Cells(i, 5).Value
            End If
        Next i
        
        Set xlWS1 = Nothing
        Set xlWS = Nothing
        Set xlWB = Nothing
    End Sub

    Have a good day,

    Tom


    Tom Xu [MSFT]
    MSDN Community Support | Feedback to us


    Wednesday, October 31, 2012 7:27 AM
    Moderator

All replies

  • Ok, so far I managed to look for input Cell form sheet1 and look for duplicate in sheet2 and show message box accordingly:

    Option Explicit
    
    Sub Check_Records()
    
        Dim rfound As Range, rngSearch As Range, sFind As String, lastrow As Long, lngCount As Long
        
        lastrow = Cells(Rows.Count, "F").End(xlUp).Row
        
        If Len(Range("A1").Value) < 1 Then
            MsgBox "No search criteria entered - - cancelling", vbExclamation
            Exit Sub
        End If
        
        Application.ScreenUpdating = False
        
        sFind = Range("A1").Value
        
        Set rngSearch = Worksheets("sheet1").Range("F2:F" & lastrow)
        
        lngCount = Application.WorksheetFunction.CountIf(rngSearch, sFind)
        
        If lngCount >= 1 Then
            MsgBox "Duplicate Records found", vbInformation
            Exit Sub
        Else
            MsgBox "No Duplicate Records found", vbInformation
        End If
        
        Application.ScreenUpdating = True
        
        Set rngSearch = Nothing
    
    End Sub

    So, what I need at this stage is to show linked sheet2.cell(E) of duplicated records in a ListBox (userform)

    Regards

    Sunday, October 21, 2012 10:03 PM
  • Hi Admin-Dev,

    Thanks for posting in the MSDN Forum.

    According to your description, I think your what to check whether Sheet1.Cell(“A1”) have duplicate value in Sheet2.Cell(“F:F”)?

    Is it right?

    Have a good day,

    Tom


    Tom Xu [MSFT]
    MSDN Community Support | Feedback to us

    Monday, October 22, 2012 2:47 AM
    Moderator
  • Hi Tom,

    yes, if ProductA is input in sheet1.Cell("A1") so it must exist in sheet2.Range("F2:F")

    but, if ProducA is input in sheet1.Cell("A1") and we found that it exist twice or more in sheet2.Range("F2:F") then I need to know the Seller that did it and his/her name is in sheet2.Cell("E")

    So, I need to see in a ListBox all the duplicate from sheet2 and the name of all the Sellers that did it

    Regards

    Monday, October 22, 2012 3:52 AM
  • Hi Admin-Dev,

    I hope following snippet can help you,

    Option Explicit
    
    Sub FindDuplicatValue()
        Dim xlWB As Workbook
        Dim xlWS As Worksheet
        Dim xlV As String
        Dim xlWS1 As Worksheet
        Dim iEnd As Integer
        Dim i As Integer
                
        Set xlWB = Application.ActiveWorkbook
        Set xlWS = xlWB.Sheets("Sheet1")
        xlV = xlWS.Range("A1").Value
        Set xlWS1 = xlWB.Sheets("Sheet2")
        iEnd = xlWS1.Cells.SpecialCells(xlCellTypeLastCell).Row
        For i = 2 To iEnd
            If xlV = xlWS1.Cells(i, 6).Value Then
                'please modify here to collect the value which your want
                MsgBox xlWS1.Cells(i, 5).Value
            End If
        Next i
        
        Set xlWS1 = Nothing
        Set xlWS = Nothing
        Set xlWB = Nothing
    End Sub

    Have a good day,

    Tom


    Tom Xu [MSFT]
    MSDN Community Support | Feedback to us

    Thursday, October 25, 2012 5:44 AM
    Moderator
  • Hi Tom,

    the code is working for MsgBox!

    How can I tweak it for ListBox, please?

    Regards

    Monday, October 29, 2012 8:06 PM
  • Hi Admin-Dev,

    I suppose you have a ListBox which named ListBox1 in a UserForm.

    Following code will do:

    Private Sub UserForm_Initialize()
        Dim xlWB As Workbook
        Dim xlWS As Worksheet
        Dim xlV As String
        Dim xlWS1 As Worksheet
        Dim iEnd As Integer
        Dim i As Integer
                
        Set xlWB = Application.ActiveWorkbook
        Set xlWS = xlWB.Sheets("Sheet1")
        xlV = xlWS.Range("A1").Value
        Set xlWS1 = xlWB.Sheets("Sheet2")
        iEnd = xlWS1.Cells.SpecialCells(xlCellTypeLastCell).Row
        For i = 2 To iEnd
            If xlV = xlWS1.Cells(i, 6).Value Then
                'please modify here to collect the value which your want
                ListBox1.AddItem xlWS1.Cells(i, 5).Value
            End If
        Next i
        
        Set xlWS1 = Nothing
        Set xlWS = Nothing
        Set xlWB = Nothing
    End Sub

    Have a good day,

    Tom


    Tom Xu [MSFT]
    MSDN Community Support | Feedback to us


    Wednesday, October 31, 2012 7:27 AM
    Moderator