Match and Merge data having same pattern with a delimiter

P

Pete2020

Board Regular
Joined
Apr 25, 2020
Messages
68
Office Version
  1. 2016
Platform
  1. Windows
Dear Helpers,

I am looking for VBA Solution which is very peculiar situation and crack my head to do it as Simple but could not do that. I request this could be done by a Macro and seeking your kind Help.

- Overview
Sheet 1 contains Column A and Column B
- Column A has unique values to be compared with Column B
- Column B contains rows with same pattern followed by text
- I need a help to merge data between 2 rows of column B

- Problem Explanation:
Sheet 1
Column A contains Unique Values of ID or string to match aganist column B
Column B data follows same pattern "Overview", "Topics", "Eligibility"
Cell values between the above pattern should be merged into a single cell with a delimiter in sheet 2 (Ignoring Blanks and removing Duplicates)

- Output Expected
In Sheet 2- create a columns with pattern mentioned and populate the row data in a single cell
It should ignore blank rows data. and remove duplicates if any

Merge Topics.xlsx
AB
1Course NameCourse Information
2Course 1Overview
3Course 1C is a Programming Language
4Course 1You can learn Basics of Computer Programming
5Course 1
6Course 1Topics:
7Course 1Basic Structures
8Course 1Data Types
9Course 1Data Types
10Course 1Data Types
11Course 1Long and Short modifiers
12Course 1Operators
13Course 1ASCII values
14Course 1Decision making and Branching
15Course 1
16Course 1Arrays
17Course 1Loops
18Course 1Eligibility
19Course 1Beginners who have never programmed before.
20Course 1Programmers switching languages to C++.
21Course 1Intermediate C++ programmers who want to level up their skills!
22Course 1Enroll Now
23Course 2Overview
24Course 2Helpful in Becoming a Andriod Developer
25Course 2Learn Java Basics for a Good Programming
26Course 2
27Course 2Topics:
28Course 2RxJava Basics
29Course 2RxJava Basics
30Course 2RxJava Basics
31Course 2RxJava Basics
32Course 2RxJava Creation Operators
33Course 2RxJava Filtering Operators
34Course 2RxJava Combining Operators
35Course 2RxJava Transformation Operators
36Course 2RxJava Subjects
37Course 2RxJava with Retrofit
38Course 2RxJava Error handling
39Course 2RxJava with MVVM Design pattern
40Course 2RXJava with repository Design Pattern
41Course 2Eligibility
42Course 2Have no experience in RxJava
43Course 2want to be better android developer
44Course 2Business Analyst
45Course 2BI Developer
46Course 2Business User of Power BI
47Course 2Business User of Excel
48Course 2Enroll Now
49Course 2Enroll Now
Sheet1



Sheet 2 after running VBA Macro
Merge Topics.xlsx
ABCD
1NameOverviewTopics:Eligibility
2Course 1C is a Programming Language|You can learn Basics of Computer ProgrammingBasic Structures|Data Types|Long and Short modifiers|Operators|ASCII values|Decision making and Branching|Arrays|LoopsBeginners who have never programmed before.|Programmers switching languages to C++.|Intermediate C++ programmers who want to level up their skills!
3Course 2Helpful in Becoming a Andriod Developer|Learn Java Basics for a Good ProgrammingRxJava Basics|RxJava Creation Operators|RxJava Filtering Operators|RxJava Combining Operators|RxJava Transformation Operators|RxJava Subjects|RxJava with Retrofit|RxJava Error handling|RxJava with MVVM Design pattern|RXJava with repository Design PatternHave no experience in RxJava|want to be better android developer|Business Analyst|BI Developer|Business User of Power BI|Business User of Excel
Sheet2
 
Sort by date Sort by votes
VBA Code: 
Sub Pete2020()

Dim STR_DICT As Object, Y As Long, DTA() As Variant, Groups() As String, SBGN As String, Z As Long

DTA = ActiveSheet.UsedRange.Value2

Groups = Split("overview,topics:,eligibility", ",")

Set STR_DICT = CreateObject("Scripting.Dictionary")

With STR_DICT

    For Y = 2 To UBound(DTA, 1)
   
        If Not IsEmpty(DTA(Y, 1)) Then
           
            If Not .Exists(DTA(Y, 1)) Then 'Create Dictionary for each course
                .Add DTA(Y, 1), CreateObject("Scripting.Dictionary")
            End If
           
            If Not IsError(Application.Match(LCase(DTA(Y, 2)), Groups, 0)) Then SBGN = LCase(DTA(Y, 2)) 'Determine if sub group needs to be changed
           
            With .ITEM(DTA(Y, 1)) 'Add text to sub dictionary if it isn't already in the string
           
                If Not .Exists(SBGN) Then
                    .Add SBGN, vbNullString
                ElseIf InStr(1, .ITEM(SBGN), DTA(Y, 2)) = 0 Then 
                    .ITEM(SBGN) = .ITEM(SBGN) & "|" & DTA(Y, 2)
                End If
               
            End With
           
        End If
       
    Next Y
   
    ReDim DTA(1 To .Count, 1 To 4)
   
    Y = 1
   
    For Each Key In .Keys
   
        DTA(Y, 1) = Key
       
        With .ITEM(Key)
       
            For Z = 0 To UBound(Groups)
                DTA(Y, Z + 2) = Replace(.ITEM(Groups(Z)), "|", vbNullString, 1, 1)
            Next Z
           
        End With
       
        Y = Y + 1
       
    Next Key
   
    ThisWorkbook.Worksheets("Sheet2").Range("A2").Resize(.Count, UBound(DTA, 2)).Value2 = DTA
   
End With

End Sub
 
Upvote 0

Excel Facts

Last used cell?
Press Ctrl+End to move to what Excel thinks is the last used cell.
Moshi, Thanks for helping me in providing the macro.Its working fine and also it helped me.

When i ran macro on my dataset, i found a flaw in my data where one of the patterns are missing "overview,topics:,eligibility", ","" because no data available for it

Can You modify the macro, if a particular pattern or string is not available , it populate in sheet 2 as "Not found"

Say, If "Topic:" word is not there in column B - then it should display as Not Found and it should run on another pattern say eligibility

Once again I Thank You for spending time for this macro.
 
Upvote 0
Pete2020 said:
Moshi, Thanks for helping me in providing the macro.Its working fine and also it helped me.

When i ran macro on my dataset, i found a flaw in my data where one of the patterns are missing "overview,topics:,eligibility", ","" because no data available for it

Can You modify the macro, if a particular pattern or string is not available , it populate in sheet 2 as "Not found"

Say, If "Topic:" word is not there in column B - then it should display as Not Found and it should run on another pattern say eligibility

Once again I Thank You for spending time for this macro.
Click to expand...
Is this what you meant?
VBA Code: 
Sub Pete2020()

Dim STR_DICT As Object, Y As Long, DTA() As Variant, Groups() As String, SBGN As String, Z As Long

DTA = ThisWorkbook.Worksheets("Sheet1").UsedRange.Value2

Groups = Split("overview,topics:,eligibility", ",")

Set STR_DICT = CreateObject("Scripting.Dictionary")

With STR_DICT

    For Y = 2 To UBound(DTA, 1)
  
        If Not (IsEmpty(DTA(Y, 1)) Or IsEmpty(DTA(Y, 2))) Then
          
            If Not .exists(DTA(Y, 1)) Then 'Create Sub-Dictionary keyed to course name ...column A
                .Add DTA(Y, 1), CreateObject("Scripting.Dictionary")
                SBGN = vbNullString        'Remove current sub group value/key from variable
            End If
          
            If Not IsError(Application.Match(LCase(DTA(Y, 2)), Groups, 0)) Then SBGN = LCase(DTA(Y, 2)) 'Determine if sub group key needs to be changed
          
            If SBGN <> vbNullString Then 'Making sure that a key for the sub Dicctionary is available
          
                With .Item(DTA(Y, 1)) 'Add text to sub dictionary if it isn't already in the string
            
                    If Not .exists(SBGN) Then'Add Text Field item keyed to the current "pattern"
                    
                        .Add SBGN, vbNullString
                        
                    ElseIf InStr(1, .Item(SBGN), DTA(Y, 2)) = 0 Then'Check if the string already exists in the target string
                    
                        .Item(SBGN) = .Item(SBGN) & "|" & DTA(Y, 2)
                        
                    End If
                
                End With
            
            End If
          
        End If
      
    Next Y
  
    ReDim DTA(1 To .Count, 1 To 4)
  
    Y = 1
  
    For Each Key In .Keys
  
        DTA(Y, 1) = Key
      
        With .Item(Key)
      
            For Z = 0 To UBound(Groups)
                If .exists(Groups(Z)) Then
                    DTA(Y, Z + 2) = Replace(.Item(Groups(Z)), "|", vbNullString, 1, 1)
                Else
                   DTA(Y, Z + 2) = "Not Found"
                End If
            Next Z
          
        End With
      
        Y = Y + 1
      
    Next Key
  
    ThisWorkbook.Worksheets("Sheet2").Range("A2").Resize(.Count, UBound(DTA, 2)).Value2 = DTA
  
End With

End Sub
 
Upvote 0
Pete2020 said:
Moshi, Thanks for helping me in providing the macro.Its working fine and also it helped me.

When i ran macro on my dataset, i found a flaw in my data where one of the patterns are missing "overview,topics:,eligibility", ","" because no data available for it

Can You modify the macro, if a particular pattern or string is not available , it populate in sheet 2 as "Not found"

Say, If "Topic:" word is not there in column B - then it should display as Not Found and it should run on another pattern say eligibility

Once again I Thank You for spending time for this macro.
Click to expand...
Can you elaborate on "and it should run on another pattern say eligibility" ?
 
Upvote 0
MoshiM said:
Can you elaborate on "and it should run on another pattern say eligibility" ?
Click to expand...

Macro, is awesome. It considering all the possible ways of considering the data.

Ignore my explanation as your macro is handling all issues

Thank You so much Moshi
 
Upvote 0
@MoshiM , Once again please help me.

I am trying to use the above macro on this pattern but it is not populating the data.Is it hardcoded with that array.

I changed the macro Split array as Groups = Split("overview,topics:,eligibility", ",") to Groups = Split("COURSESYLLABUS,Recommededbooks",",") and i run the macro, but it is showing NOT FOUND on sheet 2

Please guide me where i am doing wrong.


Text pattern.xlsx
AB
1COURSEIDDETAILS
2Course1COURSESYLLABUS
3Course1UNIT I
4Course1Introduction: Biological databases – primary, secondary and structural, Protein and GeneInformation Resources – PIR, SWISSPROT, PDB, GenBank, DDBJ. Specialized genomic resources.
5Course1UNIT II
6Course1DNA sequence analysis: cDNA libraries and EST, EST analysis, pair wise alignmenttechniques, database searching, multiple sequence alignment, tools of sequence alignment. Global and local alignments, matrices, gap penalties and statistical significance.
7Course1UNIT-III
8Course1Secondary database searching, building search protocol, computer aided drug design – basic principles, protein modeling and design. Pharmacogenomics: introduction, applications, Genome for medicine, current and futureperspectives.
9Course1UNIT-IV
10Course1Analysis packages – Commercial databases and packages, GPL software for Bioinformatics,web-based analysis tools. System modeling and metabolomics – concepts and principles.
11Course1UNIT I
12Course1IPR – Introduction to IPR and its types covering detail about Patent and Copyright; Patent Cooperation Treaty (PCT), General Agreement on Tariffs and Trade (GATT), patents and copyrights. Patentability of life forms with special reference to Microorganisms, Pharmaceutical industries, Biodiversity, Naturally occurring substances. Human genome and IPR
13Course1UNIT II
14Course1Social and Ethical issues – Introduction to ethics and ethical committee, function and responsibility of ethical committee; Social and ethical issues regarding genetic discrimination, cloning, sex determination, gene therapy, clinical trials, stem cell research; Religious and regulatory considerations in stem cell research
15Course1UNIT III
16Course1Biosafety – Definition, Requirement, Biosafety containment facilities, biohazards, genetically modified organisms (GMOs), living modified organisms (LMOs), Biosafety for human health and environment designing and management of laboratory and culture room as per the norm of GLP, GMP and FDA.
17Course1UNIT IV
18Course1Management – Planning, Organizing, Leading & Controlling; Concepts and characteristics of information; Importance of MIS; Communication – type, channels & barriers; Financial management, planning and control
19Course1RecommendedBooks
20Course11. Encyclopedia of Ethical, Legal and Policy Issues in Biotechnology, Wiley and Sons, Inc.
21Course12. Bioethics and Biosafety Paperback by M.K. Sateesh. I K International Publishing House Pvt. Ltd
22Course13. Bioethics In A Liberal Society: The Political Framework Of Bioethics Decision Making by Thomas May
23Course14. Bioethics: Christian Approach In A Pluralistic World (Critical Issues In Bioethics) by Paul Cox,Scott B. Rae, Published by Wm. B. Eerdmans Publishing Co.
24Course2COURSESYLLABUS
25Course2UNIT I
26Course2Bacteria: Representative diseases to be studied in detail are – tetanus, diphtheria, cholera, typhoid, tuberculosis, leprosy, plague, and syphilis. Infections caused by anaerobic bacteria, spirochetes, chlamydia, rickettsiae. Viruses: Representative diseases to be studied in detail are – viral hepatitis, influenza, rabies, polio and AIDS and viral cancers. Fungi: Diseases to be taken up in following categories: superficial, subcutaneous, systemic and opportunistic mycoses.
27Course2UNIT II
28Course2Protozoa:Classification, Diseases to be discussed are – amoebiasis, toxoplasmosis, trichomoniasis & leishmaniasis. Parasitic diseases, Classification: Ascariais, Liver fluke, Tape worms, Disease burden and its economic impact, Investigation of epidemics. Replication of DNA, RNA+ve and RNA-ve viruses, retroviruses
29Course2UNIT III
30Course2Viral vaccines: conventional; killed/attenuated; DNA; peptide; recombinant proteins. Sterilization techniques: biohazard hoods; containment facilities, BSL 2, 3, 4. Bacterial and viral vectors, Biological warfare agents
31Course2UNIT IV
32Course2Mode of action of antibiotics and antiviral: molecular mechanism of drug resistance (MDR) Anti-viral chemotherapy. Anti-fungal chemotherapy. Hospital-acquired infections (nosocomial), immune compromised states Modern approaches for diagnosis of infectious diseases: Basic concepts of gene probes, dot hybridization and PCR assays
33Course2RecommendedBooks
34Course21. Jawetz, Melnick, & Adelberg’s Medical Microbiology (Lange Basic Science) by Geo. F.Brooks, Janet S. Butel, Stephen A. Morse McGraw-Hill Medical; 23 edition
35Course22. Medical Microbiology: with Student Consult by Patrick R. Murray PhD (Author), Ken S. Rosenthal PhD Saunders; 7 edition
36Course23. Mims’ Medical Microbiology By (author) Richard Goering, By (author) Hazel Dockrell, By (author) Mark Zuckerman, By (author)Ivan M. Roitt, By (author) Peter L. Chiodini Saunders (W.B.) Co Ltd
Sheet1
 
Upvote 0
Pete2020 said:
@MoshiM , Once again please help me.

I am trying to use the above macro on this pattern but it is not populating the data.Is it hardcoded with that array.

I changed the macro Split array as Groups = Split("overview,topics:,eligibility", ",") to Groups = Split("COURSESYLLABUS,Recommededbooks",",") and i run the macro, but it is showing NOT FOUND on sheet 2

Please guide me where i am doing wrong.
Click to expand...

The pattern elements needed to be lowercase [Auto-changed now] and you had recommended spelled incorrectly.

VBA Code: 
Sub Pete2020()

Dim STR_DICT As Object, Y As Long, DTA() As Variant, Groups() As String, SBGN As String, Z As Long

DTA = ThisWorkbook.Worksheets("Sheet1").UsedRange.Value2

Groups = Split("COURSESYLLABUS,Recommendedbooks", ",")

For Y = LBound(Groups) To UBound(Groups)
    Groups(Y) = LCase(Groups(Y))
Next Y

Set STR_DICT = CreateObject("Scripting.Dictionary")

With STR_DICT

    For Y = 2 To UBound(DTA, 1) 'Assumes you have headers
 
        If Not (IsEmpty(DTA(Y, 1)) Or IsEmpty(DTA(Y, 2))) Then
          
            If Not .exists(DTA(Y, 1)) Then 'Create Sub-Dictionary keyed to course name ...column A
                .Add DTA(Y, 1), CreateObject("Scripting.Dictionary")
                SBGN = vbNullString        'Remove current sub group value/key from variable
            End If
            
            If Not IsError(Application.Match(DTA(Y, 2), Groups, 0)) Then SBGN = LCase(DTA(Y, 2)) 'Determine if sub group key needs to be changed
          
            If SBGN <> vbNullString Then 'Making sure that a key for the sub Dicctionary is available
          
                With .Item(DTA(Y, 1)) 'Add text to sub dictionary if it isn't already in the string
            
                    If Not .exists(SBGN) Then 'Add Text Field item keyed to the current "pattern"
                    
                        .Add SBGN, vbNullString
                        
                    ElseIf InStr(1, .Item(SBGN), DTA(Y, 2)) = 0 Then 'Check if the string already exists in the target string
                    
                        .Item(SBGN) = .Item(SBGN) & "|" & DTA(Y, 2)
                        
                    End If
                
                End With
            
            End If
          
        End If
      
    Next Y
 
    ReDim DTA(1 To .Count, 1 To UBound(Groups) + 2)
 
    Y = 1
 
    For Each Key In .Keys
 
        DTA(Y, 1) = Key
      
        With .Item(Key)
      
            For Z = 0 To UBound(Groups)
                If .exists(Groups(Z)) Then
                    DTA(Y, Z + 2) = Replace(.Item(Groups(Z)), "|", vbNullString, 1, 1)
                Else
                    DTA(Y, Z + 2) = "Not Found"
                End If
            Next Z
          
        End With
      
        Y = Y + 1
      
    Next Key
 
    ThisWorkbook.Worksheets("Sheet2").Range("A2").Resize(.Count, UBound(DTA, 2)).Value2 = DTA
 
End With

End Sub
 
Upvote 0
Pete2020 said:
@CA_Punit
The Output i am looking is pattern wise text with delimiter and NOT Count of words.

I appreciate your help

Please give me a better solution accordingly.
Click to expand...

The Count of words is only the helper columns and rows..
The result is as stated by you. (Above the helper rows)
 
Upvote 0
You must log in or register to reply here.

Similar threads

D
  • Solved
Count total award value per unique supplier
Replies
4
Views
127
Fluff
Fluff
M
  • Question Question
Different results running same macro with same data
Replies
3
Views
3K
Logit
Logit
N
  • Question Question
Join data from second worksheet with delimited list values (mults) to another worksheet with one value per cell/row and keep 1:1 relationship
Replies
2
Views
1K
HeadAgainstABrickWall
H
P
  • Question Question
Combine rows into a single cell based on word match
Replies
3
Views
572
Pete2020
P
C
  • Question Question
Best coding practices in VBA (specifically, code structure, readability, compactness, and the TEBV & TBTO rules)
Replies
1
Views
5K
Marc L
Marc L

Forum statistics

Threads
1,224,827
Messages
6,181,200
Members
453,022
Latest member
RobertV1609

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top