Get a unique combination from a Table Column using Excel VBA - vba

For example, I have a data as the following in a column:
I need to make all possible unique combinations of this in another table in 2 columns using VBA like below:
Any help on how can I achieve this? Thanks.
PS. The column data is variable. It can have various number of currencies. The above one is just a small example.

This is an example how to find all these permutations. With this you should be able to solve it.
Option Explicit
Public Sub FindPermutations()
Dim ws As Worksheet
Set ws = Worksheets("Sheet1")
Const fRow As Long = 2 'first row
Const lRow As Long = 5 'last row
Dim i As Long, j As Long
For i = fRow To lRow
For j = i + 1 To lRow
'print out all permutations
Debug.Print ws.Cells(i, "A").Value, ws.Cells(j, "A").Value
Next j
Next i
End Sub
How does it work?
It uses 2 loops. The first one i runs through all rows. The second j only from the current i row to the last row. This ensures that already found combinations are not used again.
Note that I used constants for fRow and lRow for an easy demonstration. You might want to change them into variables in a production environment.

Related

Vlookup dynamically for multiple columns data from another closed workbook without opening it

First off:
On file1 > sheet1 - I have Ids of data on column A.
On source file - I have a huge data with multiple columns with same column of Ids on column A in sheet1.
I trying vlookup to get data for multiple columns from another closed workbook but result is coming only for one column. Also i don't want to open a source file as file size is bit heavy (approx. 600mb).
below are the code which i am using for above scenario. i know this code not is correct and need more correction. So can someone help me into this.
Sub MyMacro()
Dim rw As Long, x As Range, lastrow As Long, lastcol As Long
Dim book1 As Workbook, twb As Workbook
Set twb = ThisWorkbook
Set book1 = Workbooks.Open("C:\Users\Charles Paul\Desktop\VBA\12-Oct\Record.xlsx")
Set x = book1.Worksheets("Sheet1").Range("A:A")
With twb.Sheets("Sheet1")
lastrow = x.cells(x.Rows.Count, x.Column).End(xlUp).Row
lastcol = x.cells(x.Row, x.Columns.Count).End(xlToRight).Column
For rw = 1 To .cells(Rows.Count, 1).End(xlUp).Row
.cells(rw, 2) = Application.VLookup(.cells(rw, 1).Value2, x, 1, False)
Next rw
End With
book1.Close savechanges:=False
End Sub
For large data sets, you might want to look into power query.
It is accessible from here:
I will not get into details, as setting up a query is a separate thing, but you can manage it with relevant VBA code.

Excel VBA Macro Find/Cut/Paste

I am having a difficult time coming up with a solution for a project I'm working on. I am needing a Macro to look at a specific sheet, find a specific value, and cut/paste that value at the end of the row.
Looking at the example file I have attached, you can see that each customer has a unique ID in column A.
They are answering a questionnaire, and each answer they give generates a unique ID.
The order of the answer ID's doesn't matter, as they are unique. The only one that DOES matter is the answer with Semicolons. That answer ID needs to be the customer's last ID. So I need to find a way to cut these answer ID's and paste them to the end of each row.
I want the semi-colon answer to be the last answer in the array. First time posting on here so I'm sorry if the format is incorrect.
Updated: Example File
I think that this will do what you're looking for. It goes through columns and loops through each row in those columns and once it finds a cell with a ;, it just moves that value down to the bottom of the row it was found in.
Sub AnswerID()
Dim lastCol As Long
lastCol = Cells(1, Columns.count).End(xlToLeft).Column
Dim i As Long
For i = 1 To lastCol
Dim lastRow As Long
lastRow = Cells(Rows.count, i).End(xlUp).row
Dim j As Long
For j = 1 To lastRow
If InStr(Cells(j, i), ";") > 0 Then
Cells(lastRow, i).offset(1, 0).Value2 = Cells(j, i).Value2
Cells(j, i).Value2 = vbNullString
Exit For
End If
Next j
Next i
End Sub

Code to compare each cell in a column to every cell in another column

I have two columns with random times and the times come from two different sources so the columns do not have the same amount of data points. I want to start with the first time in the first column and compare it to each time in the second column. If there is a match in times, I would like to pull relevant data. After a match is found (if there is one) I would like for the code to go to the second cell in the first column and compare it to every value in the second column and so on.
Here is the code I have so far:
Sub TransferInfo()
'Activate the Sub to Convert and Format Dates
Call ConvertDates
'Define Variables
Dim st As Worksheet
Dim ts As Worksheet
Dim lastrow As Long
Dim i As Integer
j = 2
'Find and set the last used row
Set st = ThisWorkbook.Worksheets("Data Table")
lastrow = st.Cells(st.Rows.Count, "B").End(xlUp).Row
Set ts = ThisWorkbook.Worksheets("ShopFloor")
'Cycle through/compare Row J, Column 18 based on each cell in Row I, Column 14
For i = 2 To lastrow
Do Until IsEmpty(ts.Cells(j, 8)) Or IsEmpty(st.Cells(j, 2))
If st.Cells(i, 14).Value = ts.Cells(j, 18).Value Then
st.Cells(i, 15).Value = ts.Cells(j, 2).Value
Exit Do
Else
st.Cells(i, 15).Value = ""
End If
j = j + 1
Loop
j = 2
Next i
End Sub
The other sub that I call at the beginning of this sub simply rounds the times in each column to the nearest 15 minute interval to increase the likelihood of matches between the columns.
My question is: The code does not copy and paste any more information although there are times that match between the two columns. Why would the code that I have not work? Also, with larger data sets I am afraid that this the code may crash Excel and because I have a loop within a loop trying to process a lot of data a lot of times, but I don't know of a more efficient way to accomplish what I am trying to without this code.
If anyone has any insights as to why this code doesn't work I would greatly appreciate any help.
Thanks!
Based on your code, it looks like you just need an INDEX/MATCH formula. Use this in O2 and copy down:
=IFERROR(INDEX(B:B,MATCH(N2,R:R,0)),"")
No need for VBA

VBA Nested loops in tabular data

I've had a pretty thorough search but I'm still struggling with this problem. Essentially, I have a list of various titles, each of which has 10 variables corresponding, which may or may not have data points.
I'd like to loop through the first column, with a nested loop going through each row to count and record the number of populated data points in each. Mostly I'm not sure how to reference cells in the second loop. Any help would be greatly appreciated!
I dont really understand your ultimate goal however i hope the code below will help you to go to the right direction.
As far as i understand i wrote a code that COUNT how many cells for each row where there s data.
I am not really sure if it is what you want but let me know and i will edit my code to your requirement.
Option Explicit
Sub test()
Dim wb As Workbook
Dim ws As Worksheet
Dim Lastrow As Long
Dim i As Long, j As Long, c As Long
Set wb = ThisWorkbook
Set ws = wb.Sheets("Sheet1") ' Change the name of your worksheet
Lastrow = ws.Cells(Rows.Count, 1).End(xlUp).Row ' Find the las row
With ws
For i = 1 To Lastrow 'Start at row 1 until the last row
c = 0
For j = 2 To 11 ' 10 Variables (until the column "L")
If Not IsEmpty(.Cells(i, j)) Then c = c + 1 ' Count and record the number of populated data points in each columns
Next j
.Cells(i, 12).Value = c 'Past the result in column "L"
Next i
End With
End Sub

Find row by key excel vba

I am trying to make a macro in vba to update information on sheet two from sheet one. The individual records are tied together by keys. So, one key corresponds to a record in sheet 1 and also a record in sheet two. I have the macro start off by defining the rows that are filled with data (at this stage it only has the a column). Then it enters a for loop and gets the entire rows and compares the two rows and updates them if they aren't the same. I am not sure how I would write the line for the if statement to compare the two rows that have the same key (since they aren't going to be in sequential order). Any help would be greatly appreciated. I have posted the code that I have written so far below.
Sub crossUpdate()
Dim rng1 As Range, rng2 As Range, N As Long
Dim rng1Row As Range
Dim rng2Row As Range
Dim i As Integer, j As Integer
Dim Cell As Variant
N = Cells(Rows.Count, "A").End(xlUp).row
Set rng1 = Sheet1.Cells.Range("A2:A" & N)
Set rng2 = Sheet2.Cells.Range("A2:A" & N)
For i = 2 To rng1.Rows.Count
Set rng1Row = rng1.Cells(i, 1).EntireRow
Set rng2Row = rng2.Cells(i, 1).EntireRow
Key = Sheet1.Range("A" & i)
For j = 1 To rng1.Columns.Count
If rng1Row.Cells(i, j).Value <> rng2Row.Cells(i, j).Value Then
Else
End If
Next j
Next i
End Sub
I answered a similar question here. The question asked how to compare rows.
My answer tried to quickly do these comparisons by storing a hash of the row. For your question, you could try converting both of the rows to a string and just comparing them like that. If they aren't equal, just copy one of the rows into the other.