Skip to content

Instantly share code, notes, and snippets.

Show Gist options
  • Save sharifulgeo/aaa6795fd621c33b13b1a110ea5e0c20 to your computer and use it in GitHub Desktop.
Save sharifulgeo/aaa6795fd621c33b13b1a110ea5e0c20 to your computer and use it in GitHub Desktop.
Option Explicit
Public Sub get_common_value_from_multiple_columns()
'Dim data_dictionary As New Scripting.Dictionary
Dim data_dictionary As Object
Set data_dictionary = CreateObject("Scripting.Dictionary")
Dim columns_count As Long
Dim iterator As Integer
Dim dictionary_item As Variant
Dim selected_cells As Variant
Set selected_cells = Cells(1, 1).CurrentRegion
columns_count = selected_cells.Columns.Count
selected_cells.Select
'Populate the dictionary defined earlier
For iterator = 0 To columns_count - 1:
For Each dictionary_item In selected_cells.Columns(iterator + 1).Value
If Not data_dictionary.Exists(dictionary_item) Then
data_dictionary.Item(dictionary_item) = 1
ElseIf data_dictionary.Exists(dictionary_item) Then
data_dictionary.Item(dictionary_item) = data_dictionary.Item(dictionary_item) + 1
End If
Next dictionary_item
Next iterator
'Remove the unique values
For Each dictionary_item In data_dictionary
If data_dictionary.Item(dictionary_item) < iterator Then
data_dictionary.Remove dictionary_item
End If
Next dictionary_item
'Copy the common value to a new columns
If data_dictionary.Count > 0 Then
Cells(columns_count + 2).Resize(data_dictionary.Count) = Application.Transpose(data_dictionary.Keys)
End If
End Sub
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment