Andreas Hild
Andreas Hild

Reputation: 79

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

Upvotes: 0

Views: 42

Answers (1)

Warcupine
Warcupine

Reputation: 4640

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

Upvotes: 0

Related Questions