Search code examples
excelvbastringmanipulate

Manipulate Excel table macro to another format. Remove duplicates and reformat


I'm around 2 months in my VBA journey and I have encountered a problem which I can't find a solution to online. I'm having problems manipulating an Excel table to another format which has been created by another macro that I have programmed. I have a table with country and name of a figure on different rows, listed on a couple of rows. I want it to be dynamic since this table will be updated everyday

I have written below on how I want it to look. My idea is to code the country as a digit and then remove duplicats in the country region.

I have tried to create a loop and I'm thinking that I might have to create a range for each country.

Sub ManipulateTable()
Dim Country as String
Dim USA as Range
Dim EU as Range
Dim India as Range

Const StartRow As Byte = 7
Dim LastRow as Long
LastRow = Range("A" & StartRow.(End(xlDown).Row

For i StartRow to LastRow 
Country = Range("A" & i).Value

If Country = "USA" Then Range("C" & i).value = 1
If Country = "EU" Then Range("C" & i).value = 2
If Country = "India" Then Range("C" & i).value = 3
Next i
' This to remove duplicates from column a
Range("A7:A30").RemoveDuplicates Columns:=Array(1). Header:= xlYes
' I thinking that I need to create a loop here 
' But I dont know where to start
For i StartRow to LastRow
Countryindex =  Range("C").Value
If Countryindex = 1 Then put under USA
If Countryindex = 2 Then put under EU

My Table looks like this with separate columns

    "A" "B"
     Data
1    USA Sales
2    USA Employment Figures
3    USA Tax
4    EU Sales
5    EU Employment Figures
6    India Sales
7    India Expenses 
8    India Employment Figures

I want a table which looks like this

 "A" 
 Data
1    USA: (With some color)
2    Sales
3    Employment
4    Tax
5    EU: (With some color)  
6    Sales
7    Employment
8    India: (With some color)
9    Sales
10   Expenses
11   Employment

All help is highly appriciated.

Country Data Time

Country:
Data Time

Solution

  • Save a copy before you run this it will overwrite your data.

    Dim lastrow As Long
        Dim iter As Long
        Dim diter As Long
        Dim countrydict As Object
        Dim country As String
        Dim data As String
        Dim key As Variant
    
        Set countrydict = CreateObject("Scripting.Dictionary")
    
        With ActiveSheet
            lastrow = .Cells(.Rows.Count, "A").End(xlUp).row
    
            For iter = 1 To lastrow
                country = Trim(.Cells(iter, 1).value)
                data = Trim(.Cells(iter, 2).value)
                If countrydict.Exists(country) Then
                    If Not InStr(1, countrydict(country), data) > 0 Then ' Remove Dupes
                        countrydict(country) = countrydict(country) & "|" & data ' an array would work but we can instr a string
                    End If
                Else
                    countrydict.Add country, data
                End If
            Next
            iter = 1
            For Each key In countrydict
                .Cells(iter, 1).value = key & ":"
                .cells(iter, 1).font.bold = True
                .cells(iter, 1).font.colorindex = 30
                iter = iter + 1
                For diter = 0 To UBound(Split(countrydict(key), "|"))
                    .Cells(iter, 1).value = Split(countrydict(key), "|")(diter)
                    iter = iter + 1
                Next
            Next
            .Columns("B").Clear
        End With