EDITED TO MAKE IT MORE CLEAR
Let's say I have rows with an account number in column B and non relevant data in column I and then I have rows with non relevant data in column B and a string containing account number and other info in column I. I want to group rows with the same account number and preferably paste them (grouped) to another sheet.
In short, I need to pull up accounts from column B and put them into a "database". Then I need to loop through the sheet looking for those values in column B and in column I (column I contains more than just the accounts, hence InStr) and group the rows that contain the same account number.
By group I mean to put them in adjacent rows (order is not relevant) and separate different accounts by a blank row. Moving to another spreadsheet is a nice bonus, but not mandatory.
Here's an
example of a database
Btw same accounts may occur multiple times in both columns and I need to group all of them.
Here's what I have to start, but obviously it does not work.
Sub Group_Accounts()
Dim strConcatList As String
Dim cell As Range
Dim K As Long, r As Range
K = 1
Dim w1 As Worksheet, w2 As Worksheet
Set w1 = Sheets("Sheet1")
Set w2 = Sheets("Sheet5")
For Each r In Intersect(Range("B:B"), ActiveSheet.UsedRange)
If r.Value <> "" Then
strConcatList = strConcatList & r.Value & "|"
End If
Next r
For Each r In Intersect(Range("I:I"), ActiveSheet.UsedRange)
If InStr(strConcatList, r.Value) > 0 Then
r.EntireRow.Copy Destination:=w2.Cells(K, 1)
K = K + 1
End If
Next r
End Sub
Related
I am having two Sheets , sheet1 and sheet2.
I have a table with the weekno, delay , Ok, percenatage of Delay and Percentage of OK.
In sheet 1, i am looking for the column T, and Count the number of '1' in the column. Similarly i look for column U and Count the number of '0' in the column.
the Count value has to be filled in sheet2 of the table looking into the week. I have my week in the column AX of sheet1.
I used formula like Countif for calculating the number of 1 in both the column.
could someone guide me how we can do it in VBA, to Count the value in column and pasting the result in a table in another sheet.I am struck how to start with coding. This is my sheet1, i have to Count the number of 1 in column t and u
To solve this problem, we have to use a couple of loops. First, we have to do an outer loop to go through the week numbers in sheet2, then imbedded in that loop we have to look at each row in sheet1 to see if it matches the week from sheet2 and to see if column T = 1 and if column U = 0. The code creates a counter that increase T by one every time a row in T is equal to 1 and does the same for U every time a row in U = 0.
Sub test()
Dim col As Range
Dim row As Range
Dim sh1 As Worksheet
Dim sh2 As Worksheet
Dim T As Integer
Dim U As Integer
Dim wk As String
Set sh1 = Sheets("Sheet1")
Set sh2 = Sheets("Sheet2")
For Each col In sh2.Columns 'This loops through all populated columns in row one
If sh2.Cells(1, col.Column).Value = "" Then
Exit For
End If
wk = sh2.Cells(1, col.Column).Value
For Each rw In sh1.Rows
If sh1.Cells(rw.row, 50).Value = "" Then
Exit For
End If
If sh1.Cells(rw.row, 50) = wk And sh1.Cells(rw.row, 20) = 1 Then
T = T + 1
End If
If sh1.Cells(rw.row, 50) = wk And sh1.Cells(rw.row, 21) = 0 Then
U = U + 1
End If
Next rw
sh2.Cells(2, col.Column) = T 'put counters into 2nd and 3rd row under each week, you can adjust this to put the number in a different cell.
sh2.Cells(3, col.Column) = U
T = 0 'reset counters to start looking at next week.
U = 0
Next col
End Sub
For some reason I wasn't able to view the images that you just uploaded. You may have to adjust my code to adapt to the specifics of your excel file. It will be good VBA practice for you. My code assumes the sheet2 has the week numbers going across the columns without any blank cells in between them. The vba drops the code in the 2nd and 3rd row under the corresponding week number. You can change this by changing the code that is indicated in the comments.
I have a workbook that contains table of data with fixed column E to S and unfixed rows. Every week i copy this table into another workbook called 'Summary'. I need to do some calculation for the table but first i need to delete data on column P and shift the rest to the left. However, i only want to delete column P of the currents week and ignore the weeks before. This is because i already deleted column P for previous weeks. I am currently doing it manually. since i have 20 table of data per week, it is time consuming as i need to automate most of the process. . I've create the code for the calculation process needed after deleting column P. How do i find the last table of data pasted on the worksheet and then delete column P without affecting the previous data?
This is the calculation code that i used. Probably i need to create a code for deleting column P and shift the others to left before running this calculation code.
Dim ws As WorksheetDim y As Workbook
Dim rng As Range
Dim i As Integer, r As Long, j As Long
Set y = ThisWorkbook
For Each ws In y.Worksheets
For Each rng In ws.UsedRange.SpecialCells(xlCellTypeConstants, 3).Areas
If rng.Rows.Count > 1 And rng.Columns.Count = 14 Then
j = 2
r = rng.Cells(rng.Rows.Count, 1).Row + 1
ws.Cells(r, rng.Columns(1).Column).Value = "total expenses"
For i = rng.Columns(2).Column To rng.Columns(2).Column + 12
ws.Cells(r, i).Formula = "=SUM(" & rng.Columns(j).Address & ")"
j = j + 1
Next i
End If
Next rng
Next
This is the example of the table after i paste to the worksheet where i need to delete column P (99-0) for the current week table.
Example of the table
According to your data layout, you need first to capture column S and then move to column P accordingly. This should do it:
With ws
.Range(.Range("S1").End(xlDown), .Range("S999999").End(xlUp)).Offset(,-3).Delete Shift:=xlToLeft
End With
Maybe just delete column P first before you paste? Without the sample data, it's hard to tell what your asking.
Columns("P:P").Select
Selection.Delete Shift:=xlToLeft
You can delete the column by its index in the range.
Range.CurrentRegion.Columns(12).Delete Shift:=xlToLeft
The range above is where you pasted your table. 12 is the column index. In range E:S column P is 12.
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.
I am looking to update the last column of one data table with the last column of another data table. This is part of a bigger vba code. The first table spreads from A2 to column K and row "lastrpivot1". The second goes from A1001 to column K and row "lastrpivot2". Beginning with the first row of table 2 (row1001) i have to find the equivalent row in table 1 based on the values in cells A to E.
So cells A to E or frow 1001 have to be compared to cells A to E of row 2, then row 3, then row 4... until a match if found or until row "lastrpivot1". When a match is found, the value in K must return to the K value of row 1001. EX: if AtoE of row 1001 match row AtoE of row 65, then copu K65 to K1001. there shound not be more than 1 match from each table. and if there is no match there is nothing to return.
Then we start this all over for row 1002 (second row of second chart), then 1003, 1004... to lastrpivot2.
I do use vba but i do not know all the functions. this is probably why i cant figure this out.
Thnka you
In Cell K1001, try this:
=IF((A1001&B1001&C1001&D1001&E1001)=(A1&B1&C1&D1&E1),K1,"")
Then drag the formula down.
This compares the entire row 1001 to the entire row 1, which is what you're asking for.
If you intend to find the matching row like a VLOOKUP (you kind of imply this, but it is not clear that this is your intention) then you will need to use VBA to do this.
Something like (untested):
Sub MatchTables()
Dim tbl1 as Range, tbl2 as Range
Dim var1() as Variant, var2() as Variant, v as Variant
Dim r as Long, matchRow as Long
Set tbl1 = Range("A1:K500") '## Modify as needed
Set tbl2 = Range("A1001:K15001") '## Modify as needed
ReDim var1(1 to tbl1.Rows.Count)
ReDim var2(1 to tbl2.Rows.Count)
'## store the range values, conctaenated, in array variables:
For r = 1 to tbl1.Rows.Count
var1(r) = tbl1(r,1) & tbl1(r,2) & tbl1(r,3) & tbl1(r,4) & tbl(r,5)
Next
For r = 1 to tbl2.Rows.Count
var2(r) = tbl2(r,1) & tbl2(r,2) & tbl2(r,3) & tbl2(r,4) & tbl2(r,5)
Next
r = 0
For each v in Var2
r = r+1
'## Check to see if there is a complete match:
If Not IsError(Application.Match(v, var1, False)) Then
matchRow = Application.Match(v, var1, False)
'## If there is a match, return the value from column K in the first table:
tbl2.Cells(r,11).Value = tbl1.Cells(matchRow,10).Value
Else:
tbl2.Cells(r,11).Value = vbNullString
End If
Next
End Sub
I am working on a way to generate a list based on the value of each row in a given column (G). Currently the list can copy entire rows and works perfectly. It pulls all rows if column G contains the required text ("Card") and puts them in a list on another spreadsheet with no gaps.
The problem is that I want the list to only contain information from a few columns in each row containing "Card", not the whole row.
Is there a way to make my code below pull specific cells from a row rather than using the .EntireRow function and copy the whole row?
To clarify, this spreadsheet is updated regularly by multiple different users so the information is not static. Rows are added and changed frequently and occasionally deleted. As such I cannot just copy cell values from the original sheet to the new list.
Sub AlonsoApprovedList()
Dim cell As Range
Dim NewRange As Range
Dim MyCount As Long
Dim ExistCount As Long
ExistCount = 0
MyCount = 1
'----For every cell in row G on the ESI Project Data sheet----'
For Each cell In Worksheets("ESI Project Data").Range("G6:G5000")
If cell.Value = "Card" 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 G in that row contains the value in question----'
Set NewRange = Application.Union(NewRange, cell.EntireRow)
MyCount = MyCount + 1
End If
Next cell
If ExistCount > 0 Then
NewRange.Copy Destination:=Worksheets("Alonso Approved List").Range("A3")
End If
End Sub
Additional information:
Column G drop down data validation lists containing one several
items. A complete list is in a different worksheet. Users go in to
each line item and select from a specific category.
The other columns in question contain a line item's name, category
(same as column G), a monetary value, and a date.
The code above loops through a list in the "ESI Project Data" Worksheet and detects rows by the value in cell G. It currently copies the whole row every time a key word is in cell G ("Card") in this example. I am using it to generate individual lists grouped by that key word. I just want it to pull individual cells, not use the .EntireRow function as it currently does. I do not know how to do that.
Thank you for your time!
Untested...
Sub AlonsoApprovedList()
Dim cell As Range
Dim rngDest As Range
Dim i As Long
Dim arrColsToCopy
arrColsToCopy = Array(1, 3, 4, 5)
'----For every cell in row G on the ESI Project Data sheet----'
Set rngDest = Worksheets("Alonso Approved List").Range("A3")
Application.ScreenUpdating = False
For Each cell In Worksheets("ESI Project Data").Range("G6:G5000").Cells
If cell.Value = "Card" Then
For i = LBound(arrColsToCopy) To UBound(arrColsToCopy)
With cell.EntireRow
.Cells(arrColsToCopy(i)).Copy rngDest.Offset(0, i)
End With
Next i
Set rngDest = rngDest.Offset(1, 0) 'next destination row
End If
Next cell
Application.ScreenUpdating = True
End Sub
hello is there a code that I can use to copy specific cells to another workbook by clicking a button.
here's what I am trying to do,
from workbook 1 I need to copy info from the following cells
I have Column B info on cell A40 to A69
I have Column B info on cell b2, b3, b4, b8,9,10,11,12,13,14,15 and b40 to b69
I have column D info on cells b2,
I have column G info on cell b1,b2,b3,b4
all this I need to send it to workbook2 which has the same cells assigned to this specific info.
hope I made my self clear.