Solved: Merging two columns as a unique column

[LinkND]

Hi there ^^

I am working on a project right now, and while looking on the net I came across this website. There are some great programmers around here, so here's my question regarding an Excel macro =) I would be more than happy if someone can give me some directions, because without this part I can't work on my next step to follow the ideas I have for finishing it.

I have the following! In a tab in Excel there are two columns with unique numbers/data. The first column consists out of the ID of merchants and the second one has the creditcard numbers of those merchants. Because the merchant can have different accounts, there are a couple of unique creditcard number ID's.

I want to put these two columns together into one column. This means: the code needs to filter out the ID of the merchant (which is always just one unique number) and all the creditcard numbers of that merchant (also as a unique value, but some have more accounts). If the creditcard number comes along more than once, that one can be deleted.

However, I want these numbers in one column, so this means I need to show correctly that the numbers are part of the merchant. I was thinking of starting the column with the merchant ID (bold & underlined) and below that number all the unique creditcard numbers. When that's done, below the last credit card number of the last merchant, the next merchant will be displayed - the same like the other one (bold & underlined). So on and so on..... this gives me all the information about merchants and credit card numbers in one column. I've added an Excel file with the exact list I want it to be converted to.

I appreciate it if someone can help me out a little, otherwise I am stuck for a long time and this isn't making my project go any faster I am getting interested in VB because of Excel, so I'd like to try a lot more after I have this thing working.

[Bob Phillips]

[vba]

Public Sub ProcessData()
Dim i As Long
Dim LastRow As Long
Dim tmp As Variant

With ActiveSheet

LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
.Cells(LastRow, "A").Resize(, 2).Copy .Cells(LastRow + 1, "A")
For i = LastRow To 2 Step -1

If .Cells(i, "A").Value <> .Cells(i + 1, "A").Value Then

If i <> LastRow Then

.Rows(i + 1).Insert
.Cells(i + 1, "B").Value = .Cells(i + 2, "A").Value
.Cells(i + 1, "B").Font.Bold = True
.Cells(i + 1, "B").Font.Underline = True
.Cells(i + 1, "A").Value = .Cells(i, "A").Value
End If
End If

If Not IsError(.Evaluate("MATCH(1,(" & .Range("A1").Resize(i - 1).Address & "=" & .Cells(i, "A").Address(False, False) & ")*" & _
"(" & .Range("B1").Resize(i - 1).Address & "=" & .Cells(i, "B").Address(False, False) & "),0)")) Then

.Rows(i).Delete
End If
Next i

.Range("B1").Value = .Range("A1").Value & "/" & .Range("B1").Value
.Rows(2).Insert
.Cells(2, "B").Value = .Cells(i + 2, "A").Value
.Cells(2, "B").Font.Bold = True
.Cells(2, "B").Font.Underline = True
.Rows(2).Insert
.Columns(1).Delete
.Columns(1).AutoFit
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
.Rows(LastRow).Delete
End With

End Sub
[/vba]

[LinkND]

Oh my, this works like a charm!! Many thanks man! I really appreciate your work =D now I can go to the next step.

Problem SOLVED!

[LinkND]

I have a small question left, because I was hoping to get this list at the left sorted as ascending automatically. Or descending, it doesn't really matter, because I will use this list eventually to create a report in Office Word.

Hope you can be of little help xld =)

[Bob Phillips]

I thought it already was in order?

[vba]

Public Sub ProcessData()
Dim i As Long
Dim LastRow As Long
Dim tmp As Variant

Application.ScreenUpdating = False

With ActiveSheet

.Cells.Sort key1:=.Range("A1"), key2:=.Range("B1"), header:=xlYes

LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
.Cells(LastRow, "A").Resize(, 2).Copy .Cells(LastRow + 1, "A")
For i = LastRow To 2 Step -1

If .Cells(i, "A").Value <> .Cells(i + 1, "A").Value Then

If i <> LastRow Then

.Rows(i + 1).Insert
.Cells(i + 1, "B").Value = .Cells(i + 2, "A").Value
.Cells(i + 1, "B").Font.Bold = True
.Cells(i + 1, "B").Font.Underline = True
.Cells(i + 1, "A").Value = .Cells(i, "A").Value
End If
End If

If Not IsError(.Evaluate("MATCH(1,(" & .Range("A1").Resize(i - 1).Address & "=" & .Cells(i, "A").Address(False, False) & ")*" & _
"(" & .Range("B1").Resize(i - 1).Address & "=" & .Cells(i, "B").Address(False, False) & "),0)")) Then

.Rows(i).Delete
End If
Next i

.Range("B1").Value = .Range("A1").Value & "/" & .Range("B1").Value
.Rows(2).Insert
.Cells(2, "B").Value = .Cells(i + 2, "A").Value
.Cells(2, "B").Font.Bold = True
.Cells(2, "B").Font.Underline = True
.Rows(2).Insert
.Columns(1).Delete
.Columns(1).AutoFit
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
.Rows(LastRow).Delete
End With

Application.ScreenUpdating = True

End Sub
[/vba]

[LinkND]

Yes it was, but that was only an example in the file. For my project I am importing a textfile with an average of 15.000 rows, so it takes some minutes before the last part (your code) is finished.

But now it works great ^^ the whole column is sorted from low to high, so this is finished as it is.

Many thanks ;D

[LinkND]

it looks like I need to fix another sheet. The one above is already complete, but on another sheet I need to fix a heavier convertion.

I've added my file to this message, otherwise it's impossible to know exactly what I want to accomplish. Sheet one is how I get the information from a text file and in sheet 2 is the way I want to have it by running a macro.

This time it's about calculating sales one different teller machines from merchants. Every merchant uses transaction machines to let customers pay for their goods. You can either use CHIP or PIN. What I want to get is a total of these transactions from every merchant. The code needs to calculate the total of PIN- and CHIP-transactions and the total sales of each of them.

The problem is: it needs to count them from unique automaton_id's, not merchants. For example: in my sheet company number 8 has two different machines on which sales were transacted. But it has four rows, because on each machine you can use PIN or CHIP. Sometimes there are zero transactions, so this needs to be visible.

In the file the column TRS_CHIP and TRS_PIN mean the total transactions. The last four columns are new columns, because PRODUCT_ID, TRANSACTIONS and SALES from the first sheet will be deleted after the totals are calculated.

Maybe it's kind of a heavy code I am asking, so I am sorry for the trouble I am asking thank you for reading

Dennis

[Bob Phillips]

[vba]

Public Sub ProcessData()
Dim i As Long
Dim LastRow As Long
Dim TotalsRow As Long

Application.ScreenUpdating = False

With ActiveSheet

LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
.Range("A3").Resize(LastRow - 2, 8).Sort _
key1:=.Range("D3"), key2:=.Range("E3"), key2:=.Range("F3"), header:=xlNo
.Range("A3").Resize(LastRow - 2, 8).Sort _
key1:=.Range("A3"), key2:=.Range("B3"), key2:=.Range("C3"), header:=xlNo
.Range("A1:J1").Value = Split("MERCHANT_ID,CREDIT_NR,LOKATION_ID,COMPANY_NM,AUTOMATON_ID,,TRS_PIN,T RS_CHIP,SALES_PIN,SALES_CHIP", ",")

For i = LastRow To 4 Step -1

If .Cells(i, "A").Value = .Cells(i - 1, "A").Value And _
.Cells(i, "B").Value = .Cells(i - 1, "B").Value And _
.Cells(i, "C").Value = .Cells(i - 1, "C").Value And _
.Cells(i, "D").Value = .Cells(i - 1, "D").Value And _
.Cells(i, "E").Value = .Cells(i - 1, "E").Value Then

If .Cells(i - 1, "F").Value Like "*PIN*" Then

.Cells(i - 1, "H").Cut .Cells(i - 1, "I")
Else

.Cells(i - 1, "H").Cut .Cells(i - 1, "J")
.Cells(i - 1, "G").Cut .Cells(i - 1, "H")
End If

If .Cells(i, "F").Value Like "*PIN*" Then

.Cells(i - 1, "G").Value = .Cells(i - 1, "G").Value + .Cells(i, "G").Value
.Cells(i - 1, "I").Value = .Cells(i - 1, "I").Value + .Cells(i, "H").Value
Else

.Cells(i - 1, "H").Value = .Cells(i - 1, "H").Value + .Cells(i, "G").Value
.Cells(i - 1, "J").Value = .Cells(i - 1, "J").Value + .Cells(i, "H").Value
End If

.Rows(i).Delete
Else

If .Cells(i, "F").Value Like "*PIN*" Then

.Cells(i, "H").Cut .Cells(i, "I")
Else

.Cells(i, "H").Cut .Cells(i, "J")
.Cells(i, "G").Cut .Cells(i, "H")
End If
End If
Next i
.Columns("G:J").Font.Size = 8

LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
TotalsRow = LastRow + 1
For i = LastRow To 3 Step -1

If .Cells(i, "A").Value <> .Cells(i - 1, "A").Value Then

.Rows(TotalsRow).Insert
.Rows(TotalsRow).Insert
.Cells(TotalsRow, "F").Value = "Total"
.Cells(TotalsRow, "F").Font.Bold = True
.Cells(TotalsRow, "G").Resize(, 4).FormulaR1C1 = "=SUM(R[-1]C:R" & i & "C)"
With .Cells(TotalsRow - 1, "G").Resize(, 4).Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
TotalsRow = i
End If
Next i

LastRow = .Cells(.Rows.Count, "F").End(xlUp).Row
For i = 3 To LastRow

If .Cells(i, "F").Value Like "*CHIP*" Or .Cells(i, "F").Value Like "*PIN*" Then

.Cells(i, "F").Value = ""
If .Cells(i, "G").Value = "" Then .Cells(i, "G").Value = 0
If .Cells(i, "H").Value = "" Then .Cells(i, "H").Value = 0
If .Cells(i, "I").Value = "" Then .Cells(i, "I").Value = 0
If .Cells(i, "J").Value = "" Then .Cells(i, "J").Value = 0
End If
.Cells(i, "G").Resize(, 4).HorizontalAlignment = xlLeft
Next i

.Rows(1).Font.Bold = True
End With

Application.ScreenUpdating = True

End Sub
[/vba]

[LinkND]

This is really fantastic man!! Many, many thanks for your time and help =) I've never seen someone this good with programming.

[LinkND]

Ah man something is going wrong. Your code was working, but if I use it in the file in the attachment, you can see what's going wrong. In Sheet1 you have to run the code (like you did) and in Sheet2 is the way it has to be. The whole thing is just okay, but the program is putting things on the wrong position. You can compare both sheets after running the VBA-code.

Check it out =) maybe I have done something weird

[Bob Phillips]

I think that there are errors in your predicted results, and you miss some, but I can see some numbers get transposed.

Is tis closer

[vba]

Public Sub ProcessData()
Dim i As Long
Dim LastRow As Long
Dim TotalsRow As Long
Dim fDone As Boolean

Application.ScreenUpdating = False

With ActiveSheet

LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
.Range("A3").Resize(LastRow - 2, 8).Sort _
key1:=.Range("D3"), key2:=.Range("E3"), key2:=.Range("F3"), header:=xlNo
.Range("A3").Resize(LastRow - 2, 8).Sort _
key1:=.Range("A3"), key2:=.Range("B3"), key2:=.Range("C3"), header:=xlNo
.Range("A1:J1").Value = Split("MERCHANT_ID,CREDIT_NR,LOKATION_ID,COMPANY_NM,AUTOMATON_ID,,TRS_PIN,T RS_CHIP,SALES_PIN,SALES_CHIP", ",")

For i = LastRow To 4 Step -1

If .Cells(i, "A").Value = .Cells(i - 1, "A").Value And _
.Cells(i, "B").Value = .Cells(i - 1, "B").Value And _
.Cells(i, "C").Value = .Cells(i - 1, "C").Value And _
.Cells(i, "D").Value = .Cells(i - 1, "D").Value And _
.Cells(i, "E").Value = .Cells(i - 1, "E").Value Then

If .Cells(i - 1, "F").Value Like "*PIN*" Then

.Cells(i - 1, "H").Cut .Cells(i - 1, "I")
Else

.Cells(i - 1, "H").Cut .Cells(i - 1, "J")
.Cells(i - 1, "G").Cut .Cells(i - 1, "H")
End If

If .Cells(i, "F").Value Like "*PIN*" Then

.Cells(i - 1, "G").Value = .Cells(i - 1, "G").Value + .Cells(i, "G").Value
.Cells(i - 1, "I").Value = .Cells(i - 1, "I").Value + .Cells(i, "H").Value
Else

.Cells(i - 1, "H").Value = .Cells(i - 1, "H").Value + .Cells(i, "G").Value
.Cells(i - 1, "J").Value = .Cells(i - 1, "J").Value + .Cells(i, "H").Value
End If

.Rows(i).Delete
Else

If .Cells(i, "I").Value = "" And .Cells(i, "J").Value = "" Then

If .Cells(i, "F").Value Like "*PIN*" Then

.Cells(i, "H").Cut .Cells(i, "I")
Else

.Cells(i, "H").Cut .Cells(i, "J")
.Cells(i, "G").Cut .Cells(i, "H")
End If
End If
End If
Next i
.Columns("G:J").Font.Size = 8

LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
.Range("I3").Resize(LastRow - 2, 2).NumberFormat = "#,##0.00"
TotalsRow = LastRow + 1
For i = LastRow To 3 Step -1

If .Cells(i, "A").Value <> .Cells(i - 1, "A").Value Then

.Rows(TotalsRow).Insert
.Rows(TotalsRow).Insert
.Cells(TotalsRow, "F").Value = "Total"
.Cells(TotalsRow, "F").Font.Bold = True
.Cells(TotalsRow, "G").Resize(, 4).FormulaR1C1 = "=SUM(R[-1]C:R" & i & "C)"
With .Cells(TotalsRow - 1, "G").Resize(, 4).Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
TotalsRow = i
End If
Next i

LastRow = .Cells(.Rows.Count, "F").End(xlUp).Row
For i = 3 To LastRow

If .Cells(i, "F").Value Like "*CHIP*" Or .Cells(i, "F").Value Like "*PIN*" Then

.Cells(i, "F").Value = ""
If .Cells(i, "G").Value = "" Then .Cells(i, "G").Value = 0
If .Cells(i, "H").Value = "" Then .Cells(i, "H").Value = 0
If .Cells(i, "I").Value = "" Then .Cells(i, "I").Value = 0
If .Cells(i, "J").Value = "" Then .Cells(i, "J").Value = 0
End If
.Cells(i, "G").Resize(, 4).HorizontalAlignment = xlLeft
Next i

.Rows(1).Font.Bold = True
End With

Application.ScreenUpdating = True

End Sub
[/vba]

[LinkND]

Yes, thank you xld, this one works better =) now I can see all my transactions perfectly with the total amount of money transferred from those machines.

Like you said: the transposition was the main error, but now it's fixed! I checked it out a couple of times, also by importing a large textfile and I can't see any errors.

So.... this one is finished =D thanks for the update.