I am trying to migrate a dataset from an old spreadsheet based system to a database. And I have one outstanding single issue to solve.
I have a sheet within a spreadsheet that is acting like a many-to-many table:
It has a column names
It also has a leading column as a rowID/Name making rows unique
On the crossing of rows and columns I have either an empty cell or an
‘X’ (X worked in old system as a relation between two different data
sets)
Rows_name|Column_name1 |Column_name2 |Column_nameX
Row_name1| | X | X
Row_name2| X | |
Row_name3| X | X | X
For each found 'X' I require to copy Row_name and Column_name to separate sheet ready for export.
I.E. For Row_name3 it would be three new rows in a new sheet as Row_name3 has three 'X's
Rows_name|Column_name
Row_name3|Column_name1
Row_name3|Column_name2
Row_name3|Column_name3
In effect I am solving a many to many relation by having a third table.
Therefore I am looking for a help with the algorithm to find all related column/row names for each ‘X’.
For any suggestions how to tackle this I would be very grateful.
Is this what you are trying?
Option Explicit
Sub Sample()
Dim wsInput As Worksheet, wsOutput As Worksheet
Dim LRI As Long, LRO As Long, i As Long, j As Long
'~~> Input Sheet
Set wsInput = Sheets("Sheet1")
LRI = wsInput.Range("A" & wsInput.Rows.Count).End(xlUp).Row
'~~> Output Sheet
Set wsOutput = Sheets("Sheet2")
LRO = 2
For i = 2 To LRI
With wsInput
For j = 1 To 3
If UCase(Trim(.Range("A" & i).Offset(, j).Value)) = "X" Then
.Range("A" & i).Copy wsOutput.Range("A" & LRO)
.Range("A1").Offset(, j).Copy wsOutput.Range("B" & LRO)
LRO = LRO + 1
End If
Next
End With
Next i
End Sub
SNAPSHOT
Related
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.
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.
Helloo,
I need Copy a range of data from one worksheet & paste 18 times of each data in the other worksheet.
Eg.,
I need to copy the data starting from Row 6 Column A,F,G from one sheet named "Inputs"
And need to paste the data 18 times starting from Row 6 of Column A,C,D in other sheet named "locale_Data"
So, the first data of input sheet should be pasted into Row (6:23) of sheet "locale_Data" & follows the other data in a sequential manner.
Thanks for your help!
If you have values in range say A6:A10 of Inputs worksheet and you would like to copy them in locale_Data worksheet 18 times starting at Row 6 you can do something like this.
Dim LastRow As Long
Dim i, startAt, totalRowsToCopy As Integer
Dim sheet1 As Worksheet
Dim sheet2 As Worksheet
Set sheet1 = ThisWorkbook.Worksheets("Inputs")
Set sheet2 = ThisWorkbook.Worksheets("locale_Data")
LastRow = sheet1.Cells(sheet1.Rows.Count, "A").End(xlUp).Row
sheet1.Range("A6:A" & (LastRow)).Copy
startAt = 6
totalRowsToCopy = LastRow - startAt + 1
For i = 1 To 18
sheet2.Range("A" & startAt & ":A" & (startAt + totalRowsToCopy - 1)).PasteSpecial
startAt = startAt + totalRowsToCopy
Next i
(Edited after Mat's suggestion)
If you just want to copy value in Row 6 18 times in another worksheet you can do something like this:
ThisWorkbook.Worksheets("Inputs").Range("A6").Copy
ThisWorkbook.Worksheets("locale_Data").Range("A6:A23").PasteSpecial
You have to repeat this code for each cells.
And if you want to change 18 to some other number you can always concatenate cell range like
Range("A6:A" & (6 + 18)).PasteSpecial
Let me know if this is not what you are looking for.
you can try something like this. Ihave shown for only one column. you can repeat for other columns. Make sure to change the range $A$1:$A$2 to your desired data range.
D1 = INDEX($A$1:$A$2,QUOTIENT(ROW()-ROW($D$1),18)+1)
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
The below mentioned data is for door access in a company where in we need to find the number of hours spent by a employee in office.
A employee can come in the office and swipe in and swipe out multiple times and all these details are register in the excel in non sorted order for all the employees.
I have a excel containing multiple columns
First two columns A,B are merged cells having date in this format(2015/01/25 7:27:30 PM).
The third column C has Access information having multiple entries for the below values(Entry/Exit).
For example
Column A Column B Access Employee ID Employee Name
==================================================
1. 2015/01/25 7:27:30 AM Entry 111 XYZ
2. 2015/01/25 7:30:30 AM Entry 333 ABC
3. 2015/01/25 8:30:30 AM Exit 111 XYZ
4. 2015/01/25 9:30:30 AM Entry 111 XYZ
5. 2015/01/25 9:30:30 AM Entry 444 PQR
6. 2015/01/25 10:30:30 Pm Exit 333 ABC
7. 2015/01/26 7:30:30 AM Exit 333 ABC
And so on.
Please note that the same employee can have multiple swipe in and out's throughout the day and will be clobbered among other employees information
The Goal is to as below
1) Copy the data from one sheet to another for the employees having spent time less than 9 hours for a specific day.
Here is the sample code that i have written it is work in progress
Sub HoursList()
Dim cell As Range
Dim cell1 As Range
Dim NewRange As Range
Dim NewRange1 As Range
Dim MyCount As Long
Dim ExistCount As Long
Dim ExistsCount As Boolean
Dim temp As Long
Dim MyCount1 As Long
Dim wsh As Worksheet, i As Long, lngEndRowInv As Long
Set wsh = Worksheets("Standard Door History ")
'Set cell = Range("A1")
ExistCount = 0
ExitsCount = False
MyCount = 1
MyCount1 = 1
i = 12
lngEndRowInv = wsh.Range("P" & wsh.Rows.Count).End(xlUp).Row
'----For every cell in row G on the Data sheet----'
For Each cell In wsh.Range("C12:D9085")
If cell.Value = "Entry" Then
'ExistCount = ExistCount + 1
If MyCount = 1 Then Set NewRange = cell.Offset(0, -1)
'----Sets up a new range to copy all data from the row if column in that row contains the value in question----'
Set NewRange = Application.Union(NewRange, cell.EntireRow)
MyCount = MyCount + 1
End If
Next cell
For Each cell1 In NewRange
If cell1.Value = "Mayur" Then
If MyCount1 = 1 Then Set NewRange1 = cell.Offset(0, -1)
'----Sets up a new range to copy all data from the row if column in that row contains the value in question----'
Set NewRange1 = Application.Union(NewRange1, cell.EntireRow)
MyCount1 = MyCount1 + 1
End If
Next cell1
If ExistCount > 0 Then
NewRange.Copy Destination:=Worksheets("Test").Range("A3")
End If
End Sub
Thanks
Here is a very rough version that you could use in VBA. It needs refining and error trapping, and future proofing, but it does what you want it to. It takes data from the active sheet and current adds it to the second worksheet. The date for looking up is in cell N1 of the first sheet.
Option Explicit
Sub CopyNine()
Dim LastRow As Integer
Dim DateToFind As Variant
Dim CellDate As Variant
Dim Count As Integer
Dim cel As Range
Dim DateRange As Range
Dim StaffID As String
Dim TimeStamp As Double
Dim StaffSummary As Object
Dim DS As Worksheet
Dim SS As Worksheet
Dim SSRow As Integer
LastRow = Range("A1").End(xlDown).Row
'You may wish to turn this into an input instead
DateToFind = Range("N1").Formula
Set DS = ActiveSheet
'You may wish to change this
Set SS = Sheets(2)
SSRow = 2
'Get a range containing all the correctly dated cells from the dataset
For Each cel In Range("A2:A" & LastRow).Cells
CellDate = Left(cel.Formula, InStr(1, cel.Formula, ".") - 1)
If CellDate = DateToFind Then
If DateRange Is Nothing Then
Set DateRange = cel
Else
Set DateRange = Union(DateRange, cel)
End If
End If
Next
'Create a summary dictionary of all staff IDs and their time spent in the office where 1 = 1 day
Set StaffSummary = CreateObject("scripting.dictionary")
For Each cel In DateRange.Cells
StaffID = cel.Offset(0, 3).Value
'These may need to be updated depending on your entry in the 'Entry/Exit' column
If cel.Offset(0, 2).Value = "Entry" Then
TimeStamp = -cel.Formula
Else
TimeStamp = cel.Formula
End If
If Not StaffSummary.exists(StaffID) Then
StaffSummary.Add StaffID, TimeStamp
Else
StaffSummary.Item(StaffID) = StaffSummary.Item(StaffID) + TimeStamp
End If
Next
'Copy the titles from the data sheet
SS.Range("A1:E1").Value = DS.Range("A1:E1").Value
'Copy the appropriate rows across using the dictionary you created
For Each cel In DateRange.Cells
StaffID = cel.Offset(0, 3).Value
If StaffSummary.Item(StaffID) <= 9 / 24 Then 'This is 9 hours so copy across
SS.Range("A" & SSRow & ":E" & SSRow).Value = DS.Range(cel, cel.Offset(0, 4)).Value
SSRow = SSRow + 1
End If
Next
End Sub
I would suggest using Excel's inbuilt abilities before VBA, especially if you are new to VBA. This will involve adding additional columns to your input sheet though which you can hide, but may not be ideal for your situation. It could also get quite slow as there are some large calculations, but it does depend on your original data set.
I would suggest the following (although there will be a lot of variations on it!):
1) Create a summary table for the particular day.
Create a date column in column F which is =TRUNC(A2) and copy down the table.
In M1 have your input date - e.g. 2015/01/25
In column L list all the unique Staff IDs
Below the date in M, use a SUMIFS formula and time formatting to determine how many hours each person spent. In M3 for example =SUMIFS($A:$A,$D:$D,$L2,$C:$C,"Exit",$F:$F,$M$1) - SUMIFS($A:$A,$D:$D,$L2,$C:$C,"Entry",$F:$F,$M$1) then formatting as hh:mm:ss.
In column N, use =M2<TIME(9,0,0) and drag down to work out if that individual has spent less than 9 hours in the building on that day.
You should now have a table showing all the staff and how many hours they spent in the building on that day, and a TRUE or FALSE whether they spent less than 9 hours.
2) Create your additional columns to pull the data to another sheet
In Column G, determine whether the entry is for the date in question (in cell M1) using =F2=$M$1 (should give a TRUE or FALSE)
In Column H, determine if that individual has spent less than 9 hours (from the summary table) using =INDEX(N:N, MATCH(D2, L:L,0))
In Column I, determine whether that entry should be copied across using =AND(G2, H2)
Finally in Column J, determine which entry this is to copy across using `=IF(I2, COUNTIFS($I$1:I2,TRUE),"")
Copy each of these down to the bottom of the table (you can hide them later)
3) Create your table on the next sheet for copying down - I have called my original worksheet "Data" and my second one "Copy"
In column A, use =ROW()-1 to create a sequential list of numbers
In column B, use =MATCH(A2, Data!J:J,0) to find out which row of data from the original table is being copied across
In column C, use =IFERROR(INDEX(Data!A:A,$B2),"") to pull the data from the first column
Copy this formula across to column G
Copy all of these down the sheet to however many rows of data you would like
Hide columns A, B and D since these will contain irrelevant information
You should then have an autoupdating table based on the date in cell M1 on the original data sheet. As mentioned above, this can be adapted in many ways, and it may not be ideal for your situation depending on your data set size, but it may be a start for you. If it is not suitable, then please use the theory to adapt some VBA code, as this can also be done in VBA in a very similar way.