Need a solution to club data from multiple columns and prepare a unique list

S

Siddhu11011

Board Regular
Joined
Jun 22, 2022
Messages
56
Office Version
  1. 365
Platform
  1. Windows
I have couple of columns in which accounts and account names are listed as below. I just need a solution to consolidate data from front 6 columns into last 2 columns.
ex: 1st, 3rd, and 5th columns are combined into 2nd last column and likewise for Account Names. Last 2 columns are having unique list of line items.
It would be helpful and delighted moment for me if you could just guide me with appropriate solution.

Account NumberAccount NameAccount NumberAccount NameAccount NumberAccount Name→Account NumberAccount Name
1254Shahid12458Taylorcadda3333Dinesh1254Shahid
D148Rahildf5846ReyonSsd54SureshD148Rahil
1496Sajidaw2546fRajeshsDs54Michel1496Sajid
D148Rahilaasf21531Rameshasds655Tom12458Taylor
ASas131Sairacadda3333Dineshdf5846Reyon
xazcsd32123Kiaraaw2546fRajesh
ss31Jenishaasf21531Ramesh
aasd131PankitASas131Saira
df5846Reyonxazcsd32123Kiara
aw2546fRajeshss31Jenish
aasd131Pankit
cadda3333Dinesh
Ssd54Suresh
sDs54Michel
asds655Tom
 
Sort by date Sort by votes
Hi,
VBA Code: 
Sub test()

    Application.ScreenUpdating = False
    Dim i&, ii&, krt$, sat&, sut

    Range("H2:I" & Rows.Count).ClearContents
   
    sut = Array(2, 11, 20)
    sat = 2
    With CreateObject("Scripting.Dictionary")
        For i = 0 To 2
            For ii = 2 To Cells(Rows.Count, sut(i)).End(3).Row
                krt = Cells(ii, sut(i)).Value & "~" & Cells(ii, sut(i) + 1).Value
                If Not .exists(krt) Then
                    .Item(krt) = Null
                    Cells(sat, "AC").Resize(, 2).Value = Split(krt, "~")
                    sat = sat + 1
                End If
            Next ii
        Next i
    End With
   
    Application.ScreenUpdating = True
   
End Sub
 
Upvote 0

Excel Facts

Add Bullets to Range
Select range. Press Ctrl+1. On Number tab, choose Custom. Type Alt+7 then space then @ sign (using 7 on numeric keypad)
kevin9999 said:
It would have been useful to know that at the beginning
Click to expand...
OK, try this:
VBA Code: 
Option Explicit
Sub Siddhu11011_V3()
    Application.ScreenUpdating = False
    
    '   Clear columns AC:AD of data
    Range("AC2:AD" & Cells.Find("*", , xlFormulas, , 1, 2).Row).ClearContents
    
    '   Copy data to columns AC:AD
    Dim LRow As Long, Source
    LRow = Columns("AC:AC").Resize(, 2).Find("*", , xlFormulas, , 1, 2).Row + 1
    For Each Source In Array("B2", "K2", "T2")
        With ActiveSheet.Range(Source).SpillingToRange
            Range("AC" & LRow).Resize(.Rows.Count, .Columns.Count) = .Value
            .Offset(, 1).Copy Range("AD" & LRow)
        End With
        LRow = Columns("AC:AC").Resize(, 2).Find("*", , xlFormulas, , 1, 2).Row + 1
    Next Source
    
    '   Remove the duplicates
    Range("AC:AD").RemoveDuplicates Columns:=2, Header:=xlYes
    Application.ScreenUpdating = True
End Sub
 
Upvote 0
kevin9999 said:
OK, try this:
VBA Code: 
Option Explicit
Sub Siddhu11011_V3()
    Application.ScreenUpdating = False
   
    '   Clear columns AC:AD of data
    Range("AC2:AD" & Cells.Find("*", , xlFormulas, , 1, 2).Row).ClearContents
   
    '   Copy data to columns AC:AD
    Dim LRow As Long, Source
    LRow = Columns("AC:AC").Resize(, 2).Find("*", , xlFormulas, , 1, 2).Row + 1
    For Each Source In Array("B2", "K2", "T2")
        With ActiveSheet.Range(Source).SpillingToRange
            Range("AC" & LRow).Resize(.Rows.Count, .Columns.Count) = .Value
            .Offset(, 1).Copy Range("AD" & LRow)
        End With
        LRow = Columns("AC:AC").Resize(, 2).Find("*", , xlFormulas, , 1, 2).Row + 1
    Next Source
   
    '   Remove the duplicates
    Range("AC:AD").RemoveDuplicates Columns:=2, Header:=xlYes
    Application.ScreenUpdating = True
End Sub
Click to expand...
It shows me an error in this line item "LRow = Columns("AC:AC").Resize(, 2).Find("*", , xlFormulas, , 1, 2).Row + 1". There is a popup saying "Object variable or with block variable not set"
Any advise on this?
 
Upvote 0
Siddhu11011 said:
It shows me an error in this line item "LRow = Columns("AC:AC").Resize(, 2).Find("*", , xlFormulas, , 1, 2).Row + 1". There is a popup saying "Object variable or with block variable not set"
Any advise on this?
Click to expand...
I assumed that you already had headers in row 1 at AC1:AD1 as you showed in your original post. Another reason why we ask you to provide a copy of your data using the XL2BB add in so we don't have to waste so much time. ;)

This should be OK
VBA Code: 
Option Explicit
Sub Siddhu11011_V4()
    Application.ScreenUpdating = False
    
    '   Clear columns AC:AD of data
    Range("AC2:AD" & Cells.Find("*", , xlFormulas, , 1, 2).Row).ClearContents
    
    '   Copy data to columns AC:AD
    Dim LRow As Long, Source
    Range("AC1").Resize(1, 2).Value = Array("Account Number", "Account Name")
    LRow = Columns("AC:AC").Resize(, 2).Find("*", , xlFormulas, , 1, 2).Row + 1
    For Each Source In Array("B2", "K2", "T2")
        With ActiveSheet.Range(Source).SpillingToRange
            Range("AC" & LRow).Resize(.Rows.Count, .Columns.Count) = .Value
            .Offset(, 1).Copy Range("AD" & LRow)
        End With
        LRow = Columns("AC:AC").Resize(, 2).Find("*", , xlFormulas, , 1, 2).Row + 1
    Next Source
    
    '   Remove the duplicates
    Range("AC:AD").RemoveDuplicates Columns:=2, Header:=xlYes
    Application.ScreenUpdating = True
End Sub
 
Upvote 0
kevin9999 said:
I assumed that you already had headers in row 1 at AC1:AD1 as you showed in your original post. Another reason why we ask you to provide a copy of your data using the XL2BB add in so we don't have to waste so much time. ;)

This should be OK
VBA Code: 
Option Explicit
Sub Siddhu11011_V4()
    Application.ScreenUpdating = False
 
    '   Clear columns AC:AD of data
    Range("AC2:AD" & Cells.Find("*", , xlFormulas, , 1, 2).Row).ClearContents
 
    '   Copy data to columns AC:AD
    Dim LRow As Long, Source
    Range("AC1").Resize(1, 2).Value = Array("Account Number", "Account Name")
    LRow = Columns("AC:AC").Resize(, 2).Find("*", , xlFormulas, , 1, 2).Row + 1
    For Each Source In Array("B2", "K2", "T2")
        With ActiveSheet.Range(Source).SpillingToRange
            Range("AC" & LRow).Resize(.Rows.Count, .Columns.Count) = .Value
            .Offset(, 1).Copy Range("AD" & LRow)
        End With
        LRow = Columns("AC:AC").Resize(, 2).Find("*", , xlFormulas, , 1, 2).Row + 1
    Next Source
 
    '   Remove the duplicates
    Range("AC:AD").RemoveDuplicates Columns:=2, Header:=xlYes
    Application.ScreenUpdating = True
End Sub
Click to expand...
Solution is still incorrect. I have added Xl2BB. Now what should I send you for the clarification?
General.xlsm
ABCDEFGHIJKLMNOPQRSTUVWXYZAAABACAD
1Customer Type "C"Account NumberAccount NameFrequencyRiskCodeStatusReconCustomer Type "D"Account NumberAccount NameFrequencyRiskCodeStatusReconCustomer Type "E"Account NumberAccount NameFrequencyRiskCodeStatusReconConsolidated Data From B, C, K, L, T, UAccount NumberAccount Name
2Filter Function 1) Account should be new ("Not Found" from Column J of Utility sheet) AND 2)Customer type should be "C" only (Column C of Utility sheetFilter Function 1) Account should be new ("Not Found" from Column J of Utility sheet) AND 2)Customer type should be "D" only (Column C of Utility sheetFilter Function 1) Account should be new ("Not Found" from Column J of Utility sheet) AND 2)Customer type should be "E" only (Column C of Utility sheet
Result
 
Upvote 0
Siddhu11011 said:
Solution is still incorrect
Click to expand...
That doesn't tell me much. Did it not copy any data at all? Did it copy some, but not all? To the wrong place? Did Excel crash?

You haven't shown where the "Account Name" comes from on your Xl2BB. Are they constants, the result of a formula as well, something else?
 
Upvote 0
I've assumed that your Account Names are a result of a formula. As such, this code:

VBA Code: 
Option Explicit
Sub Siddhu11011_V5()
    Application.ScreenUpdating = False
    
    '   Clear columns AC:AD of data
    Range("AC2:AD" & Cells.Find("*", , xlFormulas, , 1, 2).Row).ClearContents
    
    '   Copy data to columns AC:AD
    Dim LRow As Long, Source
    Range("AC1").Resize(1, 2).Value = Array("Account Number", "Account Name")
    LRow = Columns("AC:AC").Resize(, 2).Find("*", , xlFormulas, , 1, 2).Row + 1
    For Each Source In Array("B2", "K2", "T2")
        With ActiveSheet.Range(Source).SpillingToRange
            Range("AC" & LRow).Resize(.Rows.Count, .Columns.Count) = .Value
            .Offset(, 1).Copy
            Range("AD" & LRow).PasteSpecial (xlPasteValues)
            Application.CutCopyMode = False
        End With
        LRow = Columns("AC:AC").Resize(, 2).Find("*", , xlFormulas, , 1, 2).Row + 1
    Next Source
    
    '   Remove the duplicates
    Range("AC:AD").RemoveDuplicates Columns:=2, Header:=xlYes
    Range("AC1").Select
    Application.ScreenUpdating = True
End Sub

Turns this:
Siddhu.xlsm
ABCDEFGHIJKLMNOPQRSTUVWXYZAAABACAD
1Customer Type "C"Account NumberAccount NameFrequencyRiskCodeStatusReconCustomer Type "D"Account NumberAccount NameFrequencyRiskCodeStatusReconCustomer Type "E"Account NumberAccount NameFrequencyRiskCodeStatusReconConsolidated Data From B, C, K, L, T, UAccount NumberAccount Name
21254Shahid12458Taylorcadda3333Dinesh
3D148Rahildf5846ReyonSsd54Suresh
41496Sajidaw2546fRajeshsDs54Michel
5D148Rahilaasf21531Rameshasds655Tom
6ASas131Sairacadda3333Dinesh
7xazcsd32123Kiara
8ss31Jenish
9aasd131Pankit
10df5846Reyon
11aw2546fRajesh
12
13
14
15
Result
Cell Formulas
RangeFormula
B2:B5B2=FILTER(Utility!$B$2:$B$20,(Utility!$C$2:$C$20="C")*(Utility!$J$2:$J$20="Not Found"),"")
K2:K11K2=FILTER(Utility!$B$2:$B$20,(Utility!$C$2:$C$20="D")*(Utility!$J$2:$J$20="Not Found"),"")
T2:T6T2=FILTER(Utility!$B$2:$B$20,(Utility!$C$2:$C$20="E")*(Utility!$J$2:$J$20="Not Found"),"")
C2:C5,L2:L11,U2:U6C2=VLOOKUP(B2,Utility!$B$2:$D$20,3,FALSE)
Dynamic array formulas.


Into this:
Siddhu.xlsm
ABCDEFGHIJKLMNOPQRSTUVWXYZAAABACAD
1Customer Type "C"Account NumberAccount NameFrequencyRiskCodeStatusReconCustomer Type "D"Account NumberAccount NameFrequencyRiskCodeStatusReconCustomer Type "E"Account NumberAccount NameFrequencyRiskCodeStatusReconConsolidated Data From B, C, K, L, T, UAccount NumberAccount Name
21254Shahid12458Taylorcadda3333Dinesh1254Shahid
3D148Rahildf5846ReyonSsd54SureshD148Rahil
41496Sajidaw2546fRajeshsDs54Michel1496Sajid
5D148Rahilaasf21531Rameshasds655Tom12458Taylor
6ASas131Sairacadda3333Dineshdf5846Reyon
7xazcsd32123Kiaraaw2546fRajesh
8ss31Jenishaasf21531Ramesh
9aasd131PankitASas131Saira
10df5846Reyonxazcsd32123Kiara
11aw2546fRajeshss31Jenish
12aasd131Pankit
13cadda3333Dinesh
14Ssd54Suresh
15sDs54Michel
16asds655Tom
17
Result
Cell Formulas
RangeFormula
B2:B5B2=FILTER(Utility!$B$2:$B$20,(Utility!$C$2:$C$20="C")*(Utility!$J$2:$J$20="Not Found"),"")
K2:K11K2=FILTER(Utility!$B$2:$B$20,(Utility!$C$2:$C$20="D")*(Utility!$J$2:$J$20="Not Found"),"")
T2:T6T2=FILTER(Utility!$B$2:$B$20,(Utility!$C$2:$C$20="E")*(Utility!$J$2:$J$20="Not Found"),"")
C2:C5,L2:L11,U2:U6C2=VLOOKUP(B2,Utility!$B$2:$D$20,3,FALSE)
Dynamic array formulas.


Isn't this what you wanted?
 
Upvote 0
Another assumption: you get the Account Names from the same Filter function as the Account Numbers. In which case, this code will work:

VBA Code: 
Option Explicit
Sub Siddhu11011_V6()
    Application.ScreenUpdating = False
    
    '   Clear columns AC:AD of data
    Range("AC2:AD" & Cells.Find("*", , xlFormulas, , 1, 2).Row).ClearContents
    
    '   Copy data to columns AC:AD
    Dim LRow As Long, Source
    Range("AC1").Resize(1, 2).Value = Array("Account Number", "Account Name")
    LRow = Columns("AC:AC").Resize(, 2).Find("*", , xlFormulas, , 1, 2).Row + 1
    For Each Source In Array("B2", "K2", "T2")
        With ActiveSheet.Range(Source).SpillingToRange
            Range("AC" & LRow).Resize(.Rows.Count, .Columns.Count) = .Value
        End With
        LRow = Columns("AC:AC").Resize(, 2).Find("*", , xlFormulas, , 1, 2).Row + 1
    Next Source
    
    '   Remove the duplicates
    Range("AC:AD").RemoveDuplicates Columns:=2, Header:=xlYes
    Range("AC1").Select
    Application.ScreenUpdating = True
End Sub
 
Upvote 0
kevin9999 said:
Another assumption: you get the Account Names from the same Filter function as the Account Numbers. In which case, this code will work:

VBA Code: 
Option Explicit
Sub Siddhu11011_V6()
    Application.ScreenUpdating = False
   
    '   Clear columns AC:AD of data
    Range("AC2:AD" & Cells.Find("*", , xlFormulas, , 1, 2).Row).ClearContents
   
    '   Copy data to columns AC:AD
    Dim LRow As Long, Source
    Range("AC1").Resize(1, 2).Value = Array("Account Number", "Account Name")
    LRow = Columns("AC:AC").Resize(, 2).Find("*", , xlFormulas, , 1, 2).Row + 1
    For Each Source In Array("B2", "K2", "T2")
        With ActiveSheet.Range(Source).SpillingToRange
            Range("AC" & LRow).Resize(.Rows.Count, .Columns.Count) = .Value
        End With
        LRow = Columns("AC:AC").Resize(, 2).Find("*", , xlFormulas, , 1, 2).Row + 1
    Next Source
   
    '   Remove the duplicates
    Range("AC:AD").RemoveDuplicates Columns:=2, Header:=xlYes
    Range("AC1").Select
    Application.ScreenUpdating = True
End Sub
Click to expand...
Great! Both the codes are working but need a small help. I need only account name and number columns and here it`s fetching remaining columns as well. I don`t want frequency, risk, codes, status, and recon. Can you do that?
 
Upvote 0
Siddhu11011 said:
Great! Both the codes are working but need a small help. I need only account name and number columns and here it`s fetching remaining columns as well. I don`t want frequency, risk, codes, status, and recon. Can you do that?
Click to expand...
Do you get those other columns from the same Filter function that returns the Account names and numbers?
 
Upvote 0
You must log in or register to reply here.

Similar threads

K
  • Question
Multiple Selection from Drop Down lists and Return all Results in lookup
Replies
0
Views
352
karunk
K
A
  • Question
Need VBA code to copy/paste data from one sheet to another with multiple criteria and complex structure
Replies
0
Views
1K
Amir Wisal
A
J
  • Question
Return multiple account numbers based on multiple names from a list
Replies
9
Views
769
Special-K99
S
K
  • Question
Combining table data from multiple tables, into a new table displaying only unique rows that exist in the tables
Replies
1
Views
305
sandy666
sandy666
T
  • Question
Create List of All Missing Values from 3 Dynamic Worksheets with Criteria
Replies
3
Views
716
treemd8025
T

Forum statistics

Threads
1,216,110
Messages
6,128,890
Members
449,477
Latest member
panjongshing

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top