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.
Related
I've got a spreadsheet which is used to record multiple times/dates where services were rendered.
In the spreadsheet the columns I'm interested in comparing start at row 9, column BA-BB, BC-BD, BE-BF, BG-BH, BI-BJ, BK-BL, BM-BN, BO-BP, BQ-BR for each of the rows in minutes. I then want to add all the total differences between the dates and finally compare that total with with AF9 if populated or if that cell is blank AG9.
I want the Macro to loop through all the rows producing a total units for each row at the end of the sheet (Column BU)
The purpose of the spreadsheet is to check that the value populated in either AF or AG is in fact correct if we were to work out the difference in times and convert to units anyway.
What I've been working on so far is:
Sub CalculateDate()
Dim Result, RowNo As Long
Dim FirstDate, SecondDate As Date
Dim ws As Worksheet
Set DateCompare = ActiveWorkbook.Sheets("Master")
Set DateCompareRng = Support.Range("BA2", Support.Cells(Rows.Count, "BA").End(xlUp).Offset(0, 18))
Set DateCompareArr = DateCompareRng.Value2
RowNo = 1
Do Until DateCompare.Cells(RowNo, 1) = ""
FirstDate = DateCompare.Cells(RowNo, 1)
SecondDate = DateCompare.Cells(RowNo, 2)
DateCompareArr(FirstDate, 3) = DateDiff("m", FirstDate, SecondDate)
RowNo = RowNo + 1
Loop
End Sub
The above is my shoddy attempt at amending some logic someone else provided on the forums to a similar question. I don't want to compare specific dates I enter though as the dates will all be different throughout the cells.
I've never used this type of function before in VBA so not really sure on how to go about changing it to suit my needs. If I can manage to loop through of of the start/end times I can probably work out how to loop through additional columns and compare against another 2 columns after that.
Some sample date is:
Start 1 | Start 2
23/03/2018 12:00 | 2018-03-23 16:00 GMT
Difference = (In minutes)
Compare Difference to:
Total Units(Column AF) = 600(this is 600 minutes)
Sorry that this is such a long question. I'm just really stuck with getting started on this problem
I like your attempt, you are on the right track. Below is tested sample code, which I think will provide you with the answer you're seeking. Good luck and happy coding
Public Sub CalculateDate()
'While I don't recommend hard coding the start and end of your range
'for this example, I thought it would simplify things.
'Start of the range is the first cell, which in your example seems
'like BA9
Const RANGE_START As String = "BA9"
'End of the range is the last cell in right most column, which
'in your example was BR. I chose the 18th row, but you could
'make it whatever you need
Const RANGE_END As String = "BR18"
'Declare a worksheet variable as you've done
'And set it to the worksheet in the ActiveWorkbook as you've done
Dim ws As Worksheet
Set ws = ActiveWorkbook.Sheets("Master")
'Declare the range that contains the values you need to sum
Dim rngToSum As Range
'And set it to the range in the WorkSheet
'In this case the range will be
'ws.Range("BA9:BR18")
Set rngToSum = ws.Range(RANGE_START & ":" & RANGE_END)
'Declare an index to be used in the for loop below
'as we loop through each column in the row the
'code is summing
Dim nDx As Integer
'Declare a range for the row to be worked on
Dim rngRow As Range
'Declare a string value that will hold the
'output range(row, cell)
Dim outStr As String
'Declare an output range variable
Dim outRng As Range
'Declare a variable to hold the summation of the
'row values you want to add together
Dim rowSum As Long
'Outter loop to loop through each of the rows in the
'defined range
For Each rngRow In rngToSum.Rows
'Initialize/Reinitialize the rowSum to 0 for each row
rowSum = 0
'Inner loop to loop throug all the columns in the range
'you want to add together
For nDx = 1 To rngToSum.Columns.Count Step 2
'NOTE--> DateDiff uses lower case N for minutes, not lower case M
'I noticed that in your sample code
rowSum = rowSum + DateDiff("n", rngRow.Value2(1, nDx), rngRow.Value2(1, nDx + 1))
Next
'Completed adding all the columns together
'Assign the outPut row, cell for the output Range
'The formula below will concatenate the
'letter A with the current row number
'For example if the current row number is 9
'outStr will equal A9
outStr = "A" & rngRow.Row
'I always use Value2 since it is faster than the
'Text or Value properties of the range object
ws.Range(outStr).Value2 = rowSum
Next
End Sub
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
I'm a newbie to VBA/coding in general and my usual tactic of sticking bits of pre-written code isn't working for my problem.
I'm looking to create a macro that will do 3 things:
Allow me to find a starting point for the data in a column.
Start counting the number of rows once the cell value has
changed to a constant.
Once the value moves back to the starting point for the count to stop and record the number of cells counted in separate column with positioning of the count in that column at the start point of the count.
Repeat until the end of the data.
For this case the start point will be when the cell has a value of >0.
It will increase to a constant number (300).
Once at 300 the macro will have to count the number of rows that contain the numerical value 300 until the value goes back to 0.
Report count in a separate table on the worksheet with the entry being input at the same relative position in the new table as when the count started from the data.
And finally the loop.
I need to also do a similar count but in the horizontal direction (i.e. counting columns on a row). If anyone can create a code for the vertical/row count problem above I'd really appreciate it if you could annotate it so I can attempt to understand/learn which bits of code carry out each action and thus change it up for horizontal/column count.
I've attached a screenshot of the spreadsheet however as a new user it must be as a link. The blue highlighted table is the data used for the vertical /row count problem I am talking about. The blank table underneath the highlighted table has manually inputted correct answers for the first column of data for what I would like the macro to do in case I haven't accurately described my request.
I have also attached the horizontal table with correct manually inputted answers for row 1 in the separate table for the column count along the row.
Lastly, here is the code that I have written to tackle the problem, however it is very basic and won't run.
Sub Count0()
For Each c In Worksheets("Sheet1").Range("D30:D39")
If c.Value = 0 Then
End If
If c.Value > 0 Then
v = Range(c.Value)
For i = 3 To Rows.Count
If Cells(i, 1).Value <> v Then
MsgBox CStr(i - 2)
End If
Next i
Next c
End Sub
This worked in the limited case I tested (two columns and several rows in different patterns. It's pretty basic--there are more elegant ways to do it.
Sub Count0()
'To hold the current cell
Dim current As Range
'To hold the total number of rows and columns having data
Dim rows As Long
Dim cols As Long
'To iterate across rows and columns
Dim r As Long
Dim c As Long
'Flag/counter variables
Dim found As Long 'Saves row on which first "constant" was found
Dim count As Long 'Saves count of "contants"
'Use SpecialCells method to obtain the maximum number of rows and columns
' that have data.
cols = Worksheets("Sheet1").Cells.SpecialCells(xlCellTypeLastCell).Column
rows = Worksheets("Sheet1").Cells.SpecialCells(xlCellTypeLastCell).Row
'Increment through all columns that have data. This is a bit inefficient
' because it really isn't necessary to go through all the empty cells,
' but it works.
For c = 1 To cols
'Initialize flag/counter
found = 0
count = 0
'Increment through all rows for the current column.
For r = 1 To rows
'Examine the current cell
Set current = Worksheets("Sheet1").Cells(r, c)
'For positive values, save the first row that has the value
' and count the number of values.
If current.Value > 0 Then
If found = 0 Then found = r
count = count + 1
End If
'When the next non-positive value is reached--OR the end of the
' row is reached--and there was a constant found, write the count
' to the next worksheet in the cell corresponding to the row and
' column having the first instance of the constant.
If (current.Value <= 0 Or r = rows) And found > 0 Then
Worksheets("Sheet2").Cells(found, c).Value = count
'Reset the flag/counter
found = 0
count = 0
End If
Next r
Next c
End Sub
I was struggling with what you had written, and ended up doing this in the end. I left you variables for changing the sheets to read from and print to (assuming you can print the results to another sheet- if not it should be easy enough to change).
This should also work for all cells in your range, assuming that there are values in all boxes.
Problems I noted with your original code were:
The first if did nothing
I'm pretty sure you shouldn't use numbers in sub/function names
Dimensioning no variables is a bad idea
Anyway, give me a comment if you need any help (and well done for writing a good first question).
Sub CountZero()
Dim SourceSheet As Worksheet, SummarySheet As Worksheet
Dim CurrentCell As Range
Dim FirstRow As Long, LastRow As Long
Dim FirstColumn As Long, LastColumn As Long
Dim TotalValues As Long
Set SourceSheet = Worksheets("Sheet1")
Set SummarySheet = Worksheets("Sheet2")
FirstRow = 1
LastRow = SourceSheet.Range("A" & rows.count).End(xlUp).row
FirstColumn = 1
LastColumn = SourceSheet.Cells(1, Columns.count).End(xlToLeft).column
For col = FirstColumn To LastColumn
For Rw = FirstRow To LastRow
Set CurrentCell = SourceSheet.Cells(Rw, col)
If CurrentCell <> 0 Then
TotalValues = ProcessSection(CurrentCell)
SummarySheet.Cells(Rw, col).value = TotalValues
Rw = Rw + TotalValues
End If
Next Rw
Next col
End Sub
Function ProcessSection(FirstCellWithValue As Range) As Long
Dim Counter As Long: Counter = 0
Do Until FirstCellWithValue.Offset(Counter, 0).value <> FirstCellWithValue.value
Counter = Counter + 1
Loop
ProcessSection = Counter
End Function
As a small disclaimer, I haven't tested this, let me know if there are problems.
I have 2 sheets within the same workbook. In worksheet A called "sheet1" and worksheet B called "sheet2". From column A of sheet 1 there are upto 176080 records of duplicate ID numbers. Need to find the unique ID numbers from this column and paste it into column A of sheet 2.
Any help would be appreciated, I am new to VBA macro and found some codes online but do not understand it. Please help me and kindly provide a syntax to solve this with some explanation so I could learn how to do it on my own as well. Thanks!!
May be a little complicated, but this gives back the unique numbers in column "A".
Option Explicit
Dim i, j, count, lastrow As Integer
Dim number As Long
Sub find_unique()
lastrow = Cells.Find("*", [A1], , , xlByRows, xlPrevious).Row
For i = 1 To lastrow
number = Cells(i, 1)
For j = 1 To lastrow
If number = Cells(j, 1) Then
count = count + 1
End If
Next j
If count = 1 Then
Cells(i, 5) = number
Else
Cells(i, 5) = ""
End If
count = 0
Next i
End Sub
First the sub takes cell A1 then loops through all other cells, starting at the first, to the last cell in the active Sheet. If a number is equal to more than one cell (it's allways one, because u also check the cell with it's own value) the number will not be displayed in column E. Then it takes the next number and loops through all again until every number is checked. Small changes and the numbers will be shown in the other sheet. Hope it works for you.
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.