PDA

View Full Version : [SOLVED] Require VBA Macro logic for Multiple ID and Matching Columns data.



snkartha
12-24-2016, 02:46 AM
Hi,

I need help.

I have a program that returns me values from the database in the form of an excel.

The first column has ID, the second column is the name, and the third column matches to this. The condition here is that the ID column can repeat as there can be more than one matching row for it.

Here is an example of what I stated
---------------------------------------------------
Property Id Property Name Unit Name

1000 ABC 101
1000 ABC 102

1001 XYZ 2001
1001 XYZ 2002
---------------------------------------------------

I can re do the program to have the Property ID merged, the Property Name Merged (I prefer this approach actually) and the Unit Id showing separate like this.
---------------------------------------------------
Property Id Property Name Unit Name
101 ABC 1001
1002

1001 XYZ 2001
2001

Here is a sample screenshot
---------------------------------------------------

I want refer this sheet and show the output like this in another worksheet

1000 ABC/101,102
1001 XYZ/2001,2002

Is there a way for me to get this done ?

Thanks
Sajiv

mikerickson
12-24-2016, 08:35 AM
I strongly suggest that you choose a different final result.

There are two main problems with your desired result.

1) Merged Cells cause problems with future programming.
2) Blank rows between different data groups make it so that many of Excel's data handling features won't work.


This Routine will sort the input data and hide the duplicate values in place, so that other filtering features will continue to work for your data.


Sub Test()
With Sheet1.Range("A:A")
With Range(.Cells(1, 1), .Cells(.Rows.Count, 1).End(xlUp)).Resize(, 3)

.Sort Key1:=.Cells(2, 1), Order1:=xlAscending, Key2:=.Cells(2, 2), Order2:=xlAscending, Header:=xlYes

With .Columns(1).Resize(, 2).Offset(1, 0)
.FormatConditions.Add Type:=xlExpression, Formula1:="=(RC=r[-1]c)"
.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
.FormatConditions(1).Font.Color = .Cells(1, 1).Interior.Color
End With
End With
End With
End Sub

snkartha
12-24-2016, 04:55 PM
Hi

Very sorry. I might have misled misled with what I want in my query.

Here is what I need. There is no heading as I have stated. I put it there only for understanding. Maybe I should have explained in depth.

Like what you have stated, I have now modified the code to show the rows continuously. There are no gaps and the output now looks like this in the excel. There is no colored cells as well.

101 ABC 1001
101 ABC 1002
201 XYZ 2001
201 XYZ 2002

I am not an expert developer and hence am doing this for the first time in vba. I am sending the value 201 as a parameter. I want to iterate through the sheet, see if a value matches to 201 and then return the output like

201 XYZ/1001,1002
There are not much rows in the sheet either.. There should be a maximum of 100 or 150. Not more than that.

Here is the snapshot of the method I have written. The problem is that it always gives me the top most row value. It is not iterating nor giving me the value when I send the parameter 201



Public Function FindMatchingMultipleRecords(sheetName As String, keyValue As String)
Dim rng As Range, cell As Range
Dim strPropertyName As String
Dim strUnitName As String
Dim cnt As Integer
Set rng = Worksheets(sheetName).Range("A1")
' MsgBox (sheetName)
i = 0
Do
v2Compare = rng.Offset(i, 0).Text
MsgBox v2Compare
If v2Compare = keyValue Then
'MsgBox " Range Column number is " + i
cnt = Application.WorksheetFunction.CountIf(rng.Range("A1:A100"), v2Compare)
MsgBox " Matches "
If cnt > 0 Then
x = 0
strPropertyName = rng.Offset(i, 1).Text
MsgBox " strPropertyName " + strPropertyName
Do
strUnitName = rng.Offset(i, 2).Text
MsgBox " strUnitName " + strUnitName
FindMatchingMultipleRecords = strPropertyName + strUnitName
GoTo ExitLoop
Loop Until x = cnt
End If
GoTo ExitLoop
End If
i = i + 1
Loop Until i > 20
ExitLoop:
End Function

Thanks
Sajiv

snkartha
12-25-2016, 03:15 AM
is that one I have asked difficult to do ? I am a newbie in VBA programming and this is my first attempt !!! For getting a matching single row I have been able to do. The above request is about multiple rows matching....:-)

I dont know how to show it in a proper format. The program shows complete text non indented.

Thanks
Sajiv

snkartha
12-25-2016, 07:47 AM
I am trying different options but not able to get a break through. The excel content is like this

101 ABC 1001
101 ABC 1002
201 XYZ 2001
201 XYZ 2002

And If I search for 201, it should give me the string value back in any of the following format

201 XYZ 2001/2002 or
201 XYZ 2001,2002

I tried using Find method but unable to proceed.

Can someone help.

Thanks
Sajiv

mikerickson
12-25-2016, 01:00 PM
You could use this UDF with the formula =CombineData(201, A:A, B:B, C:C, " ", ",")

note that the criteria can be other than equals and that if you anticipate multiple results in a particular column, the NoDup arguments can be changed from their default


Function CombineData(xCriteria As Variant, PrimaryRange As Range, Range2 As Range, Range3 As Range _
, Optional colDelimiter As String = ";", Optional rowDelimiter As String = "," _
, Optional NoDup1 As Boolean = True, Optional NoDup2 As Boolean = True, Optional NoDup3 As Boolean) As String

Dim SubString1 As String, Sub1 As String
Dim SubString2 As String, Sub2 As String
Dim SubString3 As String, Sub3 As String
Dim i As Long, j As Long

With PrimaryRange
Set PrimaryRange = Application.Intersect(.Cells, .Parent.UsedRange)
End With

For i = 1 To PrimaryRange.Rows.Count
For j = 1 To PrimaryRange.Columns.Count
'If PrimaryRange.Cells(i, j) = xCriteria Then
If WorksheetFunction.CountIf(PrimaryRange.Cells(i, j), xCriteria) = 1 Then
Sub1 = PrimaryRange.Cells(i, j).Text
Sub2 = Range2.Cells(i, j).Text
Sub3 = Range3.Cells(i, j).Text

If NoDup1 Imp (InStr(1, SubString1, rowDelimiter & Sub1) = 0) Then
SubString1 = SubString1 & rowDelimiter & Sub1
End If
If NoDup2 Imp (InStr(1, SubString2, rowDelimiter & Sub2) = 0) Then
SubString2 = SubString2 & rowDelimiter & Sub2
End If
If NoDup3 Imp (InStr(1, SubString3, rowDelimiter & Sub3) = 0) Then
SubString3 = SubString3 & rowDelimiter & Sub3
End If
End If
Next j
Next i

SubString1 = Mid(SubString1, Len(rowDelimiter) + 1)
SubString2 = Mid(SubString2, Len(rowDelimiter) + 1)
SubString3 = Mid(SubString3, Len(rowDelimiter) + 1)

CombineData = SubString1 & colDelimiter & SubString2 & colDelimiter & SubString3
End Function

snkartha
12-25-2016, 05:47 PM
Thanks a lot Mike. It works like a charm.
Looks like I have a lot of homework to do and do a lot of learning on vba programming.

Actually, Mike. The calling program is in another sheet in the same workbook.

How do I pass the worksheet name in the method?

I want to use this method in the first sheet called 'SummaryReprort', and this sheet is in sheet 5 called 'UnitData'

Thanks
Sajiv

mikerickson
12-25-2016, 10:15 PM
If you put the UDF in a normal code module rather than a sheet's code module, it can be called from any sheet in the workbook. The arguments have to include sheet references (as with native Excel functions). The UDF posted does not look to a particular sheet, it looks to the ranges passed to it as arguments.

snkartha
12-26-2016, 03:29 AM
Hi Mike...

The method is there in the Module only. It is not specific to the sheet.

I am trying to call this method from 'Summary Report' worksheet in a specific cell, by passing the parameters like this. Is this the way you are hinting at

=CombineData("201", Worksheets("UnitData").Range("A:A"), Worksheets("UnitData").Range("B:B"), Worksheets("UnitData").Range("C:C"), " ",",")

Thanks
Sajiv

snkartha
12-26-2016, 05:52 AM
I think I was doing something stupid... Just now got in depth into understanding when you stated 'Native functions...'

Here is what I did now to get the output
=CombineData("201",UnitData!A1:A20,UnitData!B1:B20,UnitData!C1:C20, " ",",").

This worked and I got the desired output as well....

I am doing all these for the first time.. !!

Thanks a TON for your valuable time....