How can I repeat a fomula in a column? The fomula adds-up first 3 monthly values to get Quarterly in next column, then should move to next 3 values and so on.
Could you pelase help me? Thanks!
76
70
85
91
89
76
80
66
83
Sub sumer()
For i = 1 To 23 Step 3
Range("b" & i + 2).Value = Range("a" & i).Value + Range("a" & i + 1).Value +Range("a" & i + 2).Value
Next i
End Sub
let me know if this has answered your question
Sub SumQtr()
Dim lastRow As Long
lastRow = Range("A" & Rows.Count).End(xlUp).Row
For i = 3 To lastRow Step 3
Cells(i, 3).Value = Cells(i - 2, 2).Value + Cells(i - 1, 2).Value + Cells(i, 2).Value
Next
End Sub
Related
I have an Excel where there are people listed in rows and the working dates in columns. Each day is a cell (col)
Data:
Employee January
01 02 03 04 05 06 07 08 09 10
-------------------------------------
Joe 1 1 1 1 1 1 1
John 1 1 1
I want the following result
Expected output:
Employee Work On Date Work Off date
----------------------------------------
Joe 2019-01-01 2019-01-04
Joe 2019-01-08 2019-01-10
John 2019-01-01 2019-01-03
I can't find a way just by doing it manually.
I was thinking to insert into a database everything and then work from there... but my problem is to bulk all data as the expected result. Is there a way to achieve that with Excel or Excel/SQL?
I try to create a piece of code to satisfy your needs:
Option Explicit
Sub test()
Dim LastRow As Long, LastColumn As Long, LastRowNew As Long, Row As Long, Column As Long
Dim StartingDate As String, EndingDate As String, Name As String
With ThisWorkbook.Worksheets("Sheet1")
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
.Range("A" & LastRow + 2).Value = "Employee"
.Range("B" & LastRow + 2).Value = "Work On Date"
.Range("C" & LastRow + 2).Value = "Work Off Date"
For Row = 3 To LastRow
LastColumn = .Cells(Row, .Columns.Count).End(xlToLeft).Column
Name = Range("A" & Row).Value
StartingDate = ""
For Column = 2 To LastColumn
If .Cells(Row, Column).Value <> "" And StartingDate = "" Then
StartingDate = "2018-" & .Cells(1, Column).Value & "-" & .Cells(2, Column).Value
LastRowNew = .Cells(.Rows.Count, "A").End(xlUp).Row
.Range("A" & LastRowNew + 1).Value = Name
.Range("B" & LastRowNew + 1).Value = CDate(StartingDate)
ElseIf .Cells(Row, Column).Offset(0, 1).Value = "" And StartingDate <> "" Then
EndingDate = "2018-" & .Cells(1, Column).Value & "-" & .Cells(2, Column).Value
.Range("C" & LastRowNew + 1).Value = CDate(EndingDate)
StartingDate = ""
End If
Next Column
Next Row
End With
End Sub
Result:
You could also do it by formula using offset ranges:
In (say) A12
=IFERROR(IF(ROW()=12,A3,IF(COUNTIF(A$11:A11,A11)<COUNTIFS(INDEX($B$3:$K$4,MATCH(A11,A$3:A$4,0),0),1,INDEX($A$3:$J$4,MATCH(A11,A$3:A$4,0),0),"<>1"),
A11,INDEX(A$3:A$4,MATCH(A11,A$3:A$4,0)+1))),"")
In B12
=AGGREGATE(15,6,COLUMN(A:J)/((INDEX(A$3:J$4,MATCH(A12,A$3:A$4,0),0)<>1)*(INDEX(B$3:K$4,MATCH(A12,A$3:A$4,0),0)=1)),COUNTIF(A$11:A12,A12))
and in C12
=AGGREGATE(15,6,COLUMN(A:J)/((INDEX(B$3:K$4,MATCH(A12,A$3:A$4,0),0)=1)*(INDEX(C$3:L$4,MATCH(A12,A$3:A$4,0),0)<>1)),COUNTIF(A$11:A12,A12))
This just produces a day number at present and you can add December 31st to get a date.
I have a table with 6 columns. [ID, Status, Start Time, End Time, Hours, Sum UP]
I have counted a total amount hours between Start Time and End Time.
Now I have to count a Sum Up of this hours.
The problem is, that the sum up must be counted in a special range, starting from status "Shipped" until status "Checked" appears for only the first time. Then repeat starting again with "Shipped" until "Checked" for the next ID.
Sub SUMUP()
Dim LastRow As Long
LastRow = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row
For i = 2 To LastRow
Cells(i, 6).Value = WorksheetFunction.SumIf(Range("A2:A" & LastRow), Range("A" & i), Range("E2:E" & LastRow))
Next
End Sub
I have this code to sum up a total amount of hours. How can I write a VBA code for my case?
Thank you in advance for your help.
Try this one:
Sub SUMUP()
Dim LastRow As Long
LastRow = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row
For i = 2 To LastRow
If Range("B" & i).Value = "Shipped" Then
For j = i To LastRow
If Range("B" & j).Value <> "Checked" Then
Sum = Sum + Range("E" & j).Value
Else
Range("F" & j).Value = Sum
Exit For
End If
Next j
i = j
Sum = 0
End If
Next i
End Sub
or an array
=SUM(INDIRECT(("f"&MIN(IF((($A$1:$A$10="ID")*($B$1:$B$10="shipped")),ROW($A$1:$A$10)))&":"&"f"&MIN(IF((($A$1:$A$10=1)*($B$1:$B$10="checked")),ROW($A$1:$A$10))))))
you could use this formula, if the order Status is sorted in the correct order:
=SUMIF(INDIRECT("A"&MATCH(A2,A:A,0)&":A"&ROW(A2)),A2,INDIRECT("E"&MATCH(A2,A:A,0)&":E"&ROW(A2)))
This would be an vba solution
Sub SUMUP()
Dim LastRow As Long
Dim hours As Integer
Dim ID As Integer
Dim checked As Boolean
LastRow = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row
ID = Cells(2, 1).Value
For i = 2 To LastRow
If ID = Cells(i, 1).Value Then
If Cells(i, 2).Value <> "checked" And checked = False Then
hours = Cells(i, 6).Value + hours
Cells(i, 10).Value = hours
ElseIf Cells(i, 2).Value = "checked" And checked = False Then
checked = True
hours = Cells(i, 6).Value + hours
Cells(i, 10).Value = hours
End If
Else
ID = Cells(i, 1).Value
checked = False
hours = 0
End If
Next
End Sub
Just for completeness, I believe this non-array formula should work:-
=IF(AND(B2="checked",COUNTIFS(A$1:A2,A2,B$1:B2,"checked")=1),C2-INDEX(C$2:C$10,MATCH(A2&"shipped",INDEX(A$2:A$12&B$2:B$12,0),0)),"")
It just subtracts shipped datetime from first checked datetime.
Multiply by 24 to get the time in hours.
I need help combining rows with VBA in Excel dynamically where the value is sometimes the same in one column.
Sample Data
A B C D E
1 r 10 5 3
1 r 12 8 2
2 q 60 50 40
2 q 25 45 55
2 q 100 200 300
EDIT: mistake in my sample data, changed last value in A from 3 to 2.
Ideally, I would combine the rows where the value is the same below in column B and while combining the values in C & D separated by semi colon and summing the values in column E.
It works when there is one duplicate, but not varying numbers of duplicates (dynamic combining)
Here is basically what I have tried:
Dim i As Long
i = 2
For i = 2 to lastRow
If Cells(i, 2).Value = Cells(i + 1, 2).Value Then
Cells(i, 3).Value = Cells(i, 3).Value & ";" & Cells(i + 1, 3).Value
Cells(i, 4).Value = Cells(i, 4).Value + Cells(i + 1, 4).Value
Rows(i + 1).Delete
Else
i = i + 1
End If
Loop
We can work backwards. Before:
The sub:
Sub dural()
Dim i As Long
lastRow = 5
For i = lastRow To 2 Step -1
If Cells(i, 2).Value = Cells(i - 1, 2).Value Then
Cells(i - 1, 3).Value = Cells(i - 1, 3).Value & ";" & Cells(i, 3).Value
Cells(i - 1, 4).Value = Cells(i - 1, 4).Value + Cells(i, 4).Value
Rows(i).Delete
End If
Next i
End Sub
and after:
I think this will do what you want.
Sub Macro()
Dim lngRow As Long
For lngRow = ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row To 2 Step -1
If StrComp(Range("B" & lngRow), Range("B" & lngRow - 1), vbTextCompare) = 0 Then
If Range("C" & lngRow) <> "" Then
Range("C" & lngRow - 1) = Range("C" & lngRow - 1) & "|" & Range("C" & lngRow) & _
Range("D" & lngRow - 1) & ";" & Range("D" & lngRow)
End If
Rows(lngRow).Delete
End If
Next
Columns("D:E").Select
Selection.ClearContents
End Sub
I have an Excel Sheet where some rows may contain the same data as other rows, except for one column. I need a macro to sum all the values in that column and delete all the duplicates, except for the first one, which contains the sum of the rest. For example:
A B C D
1 a b c d
2 n j i o
3 a b c p
4 v y e b
5 a b c m
6 . . . .
In this case, the code must delete rows 3 and 5 (because they are "duplicates" of row 1), and replace the column D of row 1 with d+p+m. I managed to come up with the following code:
For j = 1 To Range("A1").End(xlDown).Row
For i = j + 1 To Range("A1").End(xlDown).Row
If Cells(j, 1).value = Cells(i, 1).value And Cells(j, 2).value = Cells(i, 2).value And Cells(j, 3).value = Cells(i, 3).value Then
Cells(j, 6) = Cells(i, 6).value + Cells(j, 6).value
Rows(i).Delete Shift:=xlUp
i = i - 1
End If
Next i
Next j
But as you may have already noticed, it's very inefficient and basic. Any better ideas?
Here is a simple code:
Sub remdup()
Dim ws As Worksheet
Dim lastrw As Long
Set ws = ActiveSheet
lastrw = ws.Range("A" & ws.Rows.Count).End(xlUp).Row
ws.Range("E1:E" & lastrw).FormulaR1C1 = "=SUMIFs(C[-1],C[-4],RC[-4],C[-3],RC[-3],C[-2],RC[-2])"
ws.Range("D1:D" & lastrw).Value = ws.Range("E1:E" & lastrw).Value
ws.Range("E1:E" & lastrw).ClearContents
With ws.Range("A1:D" & lastrw)
.Value = .Value
.RemoveDuplicates Array(1, 2, 3), xlNo
End With
End Sub
I have written a bit of code that is intended to search cells in a column, see if they start with a certain string and then return a value based on that string in another column. I have two problems, firstly the loops don't actually return any values in columns 8,9,10 or 11. Also the second loop doesn't stop running? Here is my code
Sub Possible_solution_one()
Dim i As Integer
Dim j As Integer
Dim ws As Worksheet
Set ws = ActiveSheet
For i = 2 To ws.Cells(ws.Rows.Count, "a").End(xlUp).Row
Do While Cells(i, 1).Value <> ""
If Cells(i, 2) = "Business://EXTRACTS/" & "*" Then
Cells(i, 8) = "OBS(" & Cells(i, 2).Value & ",SHARE,#DI) OR "
End If
i = i + 1
Loop
Next
For j = 2 To ws.Cells(ws.Rows.Count, "a").End(xlUp).Row
Do While Cells(j, 6).Value <> ""
If Cells(j, 6) = "Business" & "*" Then
Cells(j, 9) = "OBS(" & Cells(j, 4).Value & ",SHARE,DI) OR "
ElseIf Cells(j, 6) = "CSTM" Then
Cells(j, 10) = "PUM(" & Cells(j, 4).Value & ",#D7) OR "
ElseIf Cells(j, 6) = "*FS" Then
Cells(j, 11) = "FCON(" & Cells(j, 4).Value & ") OR "
End If
i = i + 1
Loop
Next
End Sub
To give the situation I have 1 type of string in column B and 3 types in column F. Am looking to return different things in columns 8,9,10,11 based on b and D
If you are pattern matching with wildcards, you need to use the Like operator. e.g. If Cells(i, 2) Like "Business://EXTRACTS/" & "*" Then
The Do While loops inside the For Next loops were unnecessary. It is also not a good idea to 'manually' increment the increment counter in a For ... Next loop.
The second loop was running forever because you were incrementing i, not j.
A Select Case statement would make a better fit for the multiple criteria in the second j loop.
Sub Possible_solution_one()
Dim i As Long, j As Long
Dim ws As Worksheet
Set ws = ActiveSheet
With ws
For i = 2 To .Cells(.Rows.Count, "a").End(xlUp).Row
If Not CBool(Len(Cells(i, "a").Value)) Then Exit For
If .Cells(i, 2) = "Business://EXTRACTS/" & "*" Then
.Cells(i, 8) = "OBS(" & .Cells(i, 2).Value & ",SHARE,#DI) OR "
End If
Next i
For j = 2 To .Cells(ws.Rows.Count, "a").End(xlUp).Row
Select Case .Cells(j, 6).Value
Case "Business*"
.Cells(j, 9) = "OBS(" & Cells(j, 4).Value & ",SHARE,DI) OR "
Case "CSTM"
.Cells(j, 10) = "PUM(" & Cells(j, 4).Value & ",#D7) OR "
Case "*FS"
.Cells(j, 11) = "FCON(" & Cells(j, 4).Value & ") OR "
End If
End Select
Next j
End With
End Sub
I've also incorporated a With ... End With statement to associate all of the cells to the parent ws worksheet. Note hte .Cells and not Cells. The prefixing period assigns parentage to the worksheet referenced in the With ... End With.
With no sample data, I could not completely test this rewrite but it does compile.
your second do while loop uses i=i+1 instead of j = j + 1 so it's not going to increment the cells(j, 6).value if there's anything in cells(j,6) then the loop won't stop running
For j = 2 To ws.Cells(ws.Rows.Count, "a").End(xlUp).Row
Do While Cells(j, 6).Value <> ""
If Cells(j, 6) = "Business" & "*" Then
Cells(j, 9) = "OBS(" & Cells(j, 4).Value & ",SHARE,DI) OR "
ElseIf Cells(j, 6) = "CSTM" Then
Cells(j, 10) = "PUM(" & Cells(j, 4).Value & ",#D7) OR "
ElseIf Cells(j, 6) = "*FS" Then
Cells(j, 11) = "FCON(" & Cells(j, 4).Value & ") OR "
End If
'i = i + 1
j = j + 1
Loop
Next