Created
May 7, 2021 16:52
-
-
Save sharifulgeo/aaa6795fd621c33b13b1a110ea5e0c20 to your computer and use it in GitHub Desktop.
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
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