Page 1 of 4 1 2 3 ... LastLast
Results 1 to 10 of 31

Thread: VBA Program to Compare 4 Columns in Excel (Required)

  1. #1

    VBA Program to Compare 4 Columns in Excel (Required)



    Register for a FREE account, and/
    or Log in to avoid these ads!

    Hi all

    I am New to VBA programming in Excel. Can someone please help me how to create a VBA Program to Compare 4 Columns in Excel and store the values in another column. I have searched it in multiple websites but i couldn't find it. I have got a VBA to compare 2 columns , please let me know how to create it for 4 columns

    Code:
    Private Sub CommandButton1_Click()
    Dim CompareRange As Variant, To_Be_Compared As Variant, x As Variant, y As Variant
    str1 = InputBox("Enter Column Name to be Compared")
    str2 = InputBox("Enter Column Name to Compare")
    str3 = InputBox("Enter Column Name to put the Result")
    Range(str1 & "1").Select
    Selection.End(xlDown).Select
    Set To_Be_Compared = Range(str1 & "1:" & Selection.Address)
    Range(str2 & "1").Select
    Selection.End(xlDown).Select
    Set CompareRange = Range(str2 & "1:" & Selection.Address)
    i = 1
    To_Be_Compared.Select
    For Each x In Selection
    For Each y In CompareRange
    If x = y Then
    Range(str3 & i).Value = x
    i = i + 1
    End If
    Next y
    Next x
    End Sub
    Last edited by Zack Barresse; 2014-01-21 at 02:24 PM. Reason: Added CODE tags

  2. #2
    Super Moderator JeffreyWeir's Avatar
    Join Date
    Mar 2011
    Location
    New Zealand
    Posts
    357
    Articles
    0
    Hi vijaysram. Note that iterating through a long list using this code would take quite a bit of time, and that there are a few other approaches that will be much more efficient.

    Before I start work on this, a couple of questions for you:


    1. Roughly how many rows are there in your data?
    2. Are you effectively only interested in finding duplicate values within the 4 lists? Do you want to return items that appear in all four lists, or that appear in any two of the four lists, or that appear in one 'master' list and also in one of the other 3?

  3. #3
    Quote Originally Posted by JeffreyWeir View Post
    Hi vijaysram. Note that iterating through a long list using this code would take quite a bit of time, and that there are a few other approaches that will be much more efficient.

    Before I start work on this, a couple of questions for you:


    1. Roughly how many rows are there in your data?
    2. Are you effectively only interested in finding duplicate values within the 4 lists? Do you want to return items that appear in all four lists, or that appear in any two of the four lists, or that appear in one 'master' list and also in one of the other 3?
    Hi Jeffey, Thanks for your Interest in assisting me. I have 8 columns of Data having maximum of 2500 rows in each column. My requirement is :

    1) If I run the macro, it should ask me for the input of Column names to be compared and also should ask for the column where it need to put the result with the column heading as result.

    2) The result which i expected on the result column is the common duplicate values found on all the 4 columns.

  4. #4
    Super Moderator JeffreyWeir's Avatar
    Join Date
    Mar 2011
    Location
    New Zealand
    Posts
    357
    Articles
    0
    Quick question: Are the items likely to be unique within a column? e.g. something like unique customer numbers etc. Or is it possible that there might be duplicates both within a column, and between columns?

    Does each column hold the same type of data, or different? What's this actually for? (Often it helps me to conceptualize the problem and best solution if I have an idea of the real-world use).

    Can you upload a sample spreadsheet containing the type of data you are working with?
    Last edited by JeffreyWeir; 2013-06-20 at 11:40 AM.

  5. #5
    Quote Originally Posted by JeffreyWeir View Post
    Quick question: Are the items likely to be unique within a column? e.g. something like unique customer numbers etc. Or is it possible that there might be duplicates both within a column, and between columns?Does each column hold the same type of data, or different? What's this actually for? (Often it helps me to conceptualize the problem and best solution if I have an idea of the real-world use).Can you upload a sample spreadsheet containing the type of data you are working with?
    Hi All the 4 columns will have similar type of data. i.e. Like Column A will have numbers from range 1 to 2500 and column B will have numbers from range 20 to 2500 and Column C will have numbers from range 230 to 2500 and column D will have numbers from range 40 to 2500. The prgrm needs to ask which of the 4 columns need to be checked.. I may need to compare either columnns A, B, C, D or E,F,G,N etc. Also, it may be have a option to compare to 6 columns and 8 columns in future..

  6. #6
    Super Moderator JeffreyWeir's Avatar
    Join Date
    Mar 2011
    Location
    New Zealand
    Posts
    357
    Articles
    0
    Cool. I'll code something up that allows you to select any number of ranges, so that you're all set for the future. Will use the Dictionary object. For anyone following along at home, there's an excellent reference on Dictionaries at:
    http://www.experts-exchange.com/Soft...ss-in-VBA.html

  7. #7
    Super Moderator JeffreyWeir's Avatar
    Join Date
    Mar 2011
    Location
    New Zealand
    Posts
    357
    Articles
    0
    Hi Vijaysram.

    This code will handle any number of ranges.

    Keep adding ranges until you don't need any more, then push Cancel.
    You can select whole columns, or particular ranges within a column.
    The ranges don't even need to be the same size.

    This was fun to code up. Thanks for the challenge, and let me know if you have any questions or issues.

    Code:
    Option Explicit
    Option Base 1
    Sub CompareRanges()
    
    
        Dim rngOutput As Range
        Dim rngAllLists As Range
        Dim dic1 As Object    ' We are using late binding. If we were using early binding we would have used this:  Dim dic As Scripting.Dictionary
        Dim dic2 As Object
        Dim lng As Long
        Dim lngRange As Long
        Dim varItems As Variant
        Dim strMessage As String
        Dim bExit As Boolean
    
        Set rngOutput = Application.InputBox _
                        (Title:="Select Output cell", _
                         Prompt:="Step 1: Select the cell where you want the output to start.", Type:=8)
    
        Set dic1 = CreateObject("Scripting.Dictionary")
        Set dic2 = CreateObject("Scripting.Dictionary")
        varItems = True
    
        Do Until bExit = True 'This won't actually ever get called
            lngRange = lngRange + 1
            strMessage = "Select the " & lngRange & OrdinalSuffix(lngRange) & " range that you want to compare."
            If lngRange > 2 Then
                strMessage = strMessage & vbNewLine & vbNewLine
                strMessage = strMessage & "If you have no more ranges to add, push Cancel"
            End If
    
            varItems = Application.Transpose(Application.InputBox _
                                             (Title:="Select " & lngRange & OrdinalSuffix(lngRange) & " range...", _
                                              Prompt:=strMessage, _
                                              Type:=8))
            
            If VarType(varItems) = vbBoolean Then
                lngRange = lngRange - 1
                Exit Do
            End If
          
    
            If lngRange = 1 Then
                'First Pass: Just add the items to dic1
                For lng = 1 To UBound(varItems)
                    If Not dic1.exists(varItems(lng)) Then dic1.Add varItems(lng), varItems(lng)
                Next
            ElseIf lngRange Mod 2 = 0 Then
                'Test if items in dic1, and IF SO then add them to dic2
                dic2.RemoveAll
                For lng = 1 To UBound(varItems)
                    If dic1.exists(varItems(lng)) Then
                        If Not dic2.exists(varItems(lng)) Then dic2.Add varItems(lng), varItems(lng)
                    End If
                Next
            Else
                'Test if items in dic2, and IF SO then add them to dic1
                dic1.RemoveAll
                For lng = 1 To UBound(varItems)
                    If dic2.exists(varItems(lng)) Then
                        If Not dic1.exists(varItems(lng)) Then dic1.Add varItems(lng), varItems(lng)
                    End If
                Next
            End If
        Loop
    
        'Write the remaining items back to the worksheet.
        If lngRange Mod 2 = 0 Then
            varItems = dic2.items
        Else
            varItems = dic1.items
        End If
        rngOutput.Resize(UBound(varItems)).Value = Application.Transpose(varItems)
    
    
        'Cleanup
        Set dic1 = Nothing
        Set dic2 = Nothing
    
    End Sub

  8. #8
    Hi Jeffrey

    Thank you so much for your time and effort on this :-)

    I have tried to run the program but it was giving me error : " Compiler Error: Sub or Function not defined " and it is highlighting

    "OrdinalSuffix" . I am using Office 2013.

    Thanks again for your time..

  9. #9
    Super Moderator JeffreyWeir's Avatar
    Join Date
    Mar 2011
    Location
    New Zealand
    Posts
    357
    Articles
    0
    Whoops, sorry I forgot to include that sub.
    Code:
    Function OrdinalSuffix(ByVal Num As Long) As String
            Dim N As Long
            Const cSfx = "stndrdthththththth" ' 2 char suffixes
            N = Num Mod 100
            If ((Abs(N) >= 10) And (Abs(N) <= 19)) _
                    Or ((Abs(N) Mod 10) = 0) Then
                OrdinalSuffix = "th"
            Else
                OrdinalSuffix = Mid(cSfx, _
                    ((Abs(N) Mod 10) * 2) - 1, 2)
            End If
        End Function
    Just pop this below the End Sub of the other routine. Sorry about that.

  10. #10
    Thank you so much Jeffrey for your kind assistance..It helps me to save a lot of time :-)

Page 1 of 4 1 2 3 ... LastLast

Tags for this Thread

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •