How to call a function

[Shweta]

Hi All,

Here is my query:

Table 1(DATA)

[TABLE="width: 313"]
<colgroup><col><col span="2"></colgroup><tbody>[TR]
[TD]Departments[/TD]
[TD][/TD]
[TD]Sub Cat.[/TD]
[/TR]
[TR]
[TD]Department of Chemical[/TD]
[TD][/TD]
[TD]Oxygen[/TD]
[/TR]
[TR]
[TD]Department of Chemical[/TD]
[TD][/TD]
[TD]Carbon[/TD]
[/TR]
[TR]
[TD]Department of Chemical[/TD]
[TD][/TD]
[TD]Hydrozen[/TD]
[/TR]
[TR]
[TD]Department of Law[/TD]
[TD][/TD]
[TD]Labour Law[/TD]
[/TR]
[TR]
[TD]Department of Law[/TD]
[TD][/TD]
[TD]Civil Law[/TD]
[/TR]
[TR]
[TD]Department of Chemical[/TD]
[TD][/TD]
[TD]Co2[/TD]
[/TR]
</tbody>[/TABLE]

Table2(OUTPUT)

[TABLE="width: 422"]
<colgroup><col><col><col></colgroup><tbody>[TR]
[TD]Departments[/TD]
[TD][/TD]
[TD]Sub Cat.[/TD]
[/TR]
[TR]
[TD]Department of Chemical[/TD]
[TD][/TD]
[TD]Oxygen,Carbon,Hydrogen,Co2[/TD]
[/TR]
[TR]
[TD]Department of Law[/TD]
[TD][/TD]
[TD]Labour Law, Civil Law[/TD]
[/TR]
</tbody>[/TABLE]

I have written the following code for it in module

Sub unique()
Dim arr, distinct() As String
Dim clctn As New Collection
Dim i As Integer
Dim sht As Worksheet


Set sht = Worksheets("Sh-6")


Range("I1") = "Departments"
arr = Application.Transpose(sht.Cells(2, 6).CurrentRegion.Resize(, 1).Value)


On Error Resume Next
For i = LBound(arr) To UBound(arr)
clctn.Add arr(i), arr(i)
Next
On Error GoTo 0


ReDim distinct(1 To clctn.Count)
For i = 1 To clctn.Count
distinct(i) = clctn(i)
Next


sht.Cells(1, 9).Resize(clctn.Count).Value = Application.Transpose(distinct)


Range("J1") = "Sub Category"


End Sub

It is giving me the following output

[TABLE="width: 446"]
<colgroup><col><col><col></colgroup><tbody>[TR]
[TD]Departments[/TD]
[TD][/TD]
[TD]Sub Category[/TD]
[/TR]
[TR]
[TD]Department of Chemical[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Department of Law[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]


For another part of the query I have written a function and it is working fine

Function consol_data(x As String, y As Range, z As Integer)
Dim pan As String
Dim acell As Range
For Each acell In y
If acell.Value = x Then
pan = pan & "," & acell.Offset(0, z).Value
End If
Next
consol_data = Right(pan, Len(pan) - 1)
End Function

But the problem is I want to use a single macro to do this.

For this purpose I need to call this function in the above code but I dont know how to do this.

Please help me out on this.

Thanks!

Regards,
Shweta

 

[taurean]

Hi Shweta,

Assuming this Data is in Column A and B then following code will get this data posted in C2.

Public Sub PrepareUploadData()
Dim i As Long
Dim objDic As Object
Dim varRng As Variant

varRng = Range("A2:B" & Range("A" & Rows.Count).End(xlUp).Row).Value
Set objDic = CreateObject("Scripting.Dictionary")

With objDic
    .comparemode = vbTextCompare
    
    For i = LBound(varRng) To UBound(varRng)
        If Not .exists(varRng(i, 1)) Then
            .Add varRng(i, 1), varRng(i, 2)
        Else
            .Item(varRng(i, 1)) = .Item(varRng(i, 1)) & ", " & varRng(i, 2)
        End If
    Next i
    
    Range("C2").Resize(.Count, 2).Value = Application.Transpose(Array(.keys, .items))

End With

End Sub

 

[Shweta]

Thanks Taurean!

Working as per my need.

 

[Shweta]

Taurean can you please tell me how to be perfect in VBA.

I just have basic knowledge for it.

 

[taurean]

Hi Shweta,

I really do not know how to answer this question. If you are looking for references / resources to then you can search this site and you will come across hiker's list.

This website and many other sites provide you excellent support and information. The information is so overwhelming that you will feel inundated with it. So you need to be wise in using these 'online' resources. For example, you can visit MrExcel on daily basis in your spare time. Read anything that interests you. After few days, you will get an idea of the capabilities of this software. Also you will get to see "live" examples of people utilizing its capability and the best part: experts from all over the world advice people about the best practices / approaches. They are all "Gurus" and they teach you for free. It is up to you to learn from their interactions. Don't be just a reader / watcher, participate where you think you know a good approach. That will instil a belief in your capabilities and will make you explore things on your own.

Don't work only on VBA. That is akin to visiting a gym and working only on biceps. Will it be good? Instead the focus needs to be on all body parts. Similarly, you will have to work on Excel as whole including its native non-VBA capacity as then it'll let you select the best course for a given scenario.

Read a few books:
1. Overall Excel ---> Excel Bible - John Walkenbach
2. VBA --->
a. P2P Series - Wrox - John Green / Stephen Bullen,
b. VBA Developer's Handbook - Wiley- Ken Getz / Mike Gilbert

1. How much VBA and macros do you need in day to day activities [especially requirement as a professional]?
-- If you need it for your professional work then you will be 'pushed' to do it. On the other hand, you know what good it can do to your life (especially if you are using lot of Office Suite applications) and that is why you want to learn it then probably it will be easier for you to commit.

2. How much of your personal time are you going to spare for this?
-- This is the most important part of the whole equation. Any learning, requires personal time and commitment. Try to work out a plan that will let you learn things you want to. Probably, building "to learn" list will be good.

I hope this helps you in some way.

 

[Shweta]

Thanks Taurean!

I will try to follow this and I hope this is going to help me lot.