I am new with VBA for Excel as I work on a project that involves lots of calculations, which I want to automate with VBA. My data ranges from 15 months. To do this, I use loops and formulas but the code results into diferent results. Spefically:
1 - I would like to calculate the sum of values for next month and show the result in the last day of previous month. This is done in column H11.
2- I would like to use this formula =H11-G11-F11 in the last day of the month, after having determined the value of H11.
3- I want to calculate the values of next month following the same logic expect that, in this case my formula depends on the results from previous months. For instance: G29=L11+L112*K31; I know the value in K31.
Here is the code I am using:
Dim i As Long
Dim lrow As Long
Dim start_dif As Double
lrow = Cells(Rows.Count, "A").End(xlUp).Row
For i = 26 To lrow
data = Cells(i, "A")
next_date = Cells(i + 1, "A")
If Month(next_date) = Month(data) + 1 Or _
Year(next_date) = Year(data) + 1 Then
'first diference
start_dif = Cells(i, "I").Value
'Calculating value in G for each end of month
Cells(i, "G").Value = start_dif + start_dif * Cells(i, "K").Value
'setting up next start_dif
start_dif = Cells(i + 1, "I").Value
End If
Next i
Please note that I could not figured out the code for calculating the sum. Let me say how grateful I am for your help.
Related
I kindly ask you help me on this issue.
Please look Data below:
Name StartDate EndDate
John 17.07.2016 17.07.2017
John 17.07.2017 17.07.2018
Maria 01.08.2017 01.08.2018
Chris 05.01.2018 05.01.2019
Workers and their working years. I need to add new line for worker when his/her working year finished. For example when the date > 17.07.2018 I need to add new line for John. (date = today formula)
It look like simple but this is a part of my vacation module.
I started to write code like this.
Sub AddWorkingYearLine()
Dim WorVac As Worksheet: Set WorVac = Worksheets("WorkerVacation")
Dim i As Long
Dim LRow As Long
Dim LCol As Long
Dim MyTable As Variant
LRow = Range("A1048576").End(xlUp).Row: LCol = Range("XFD4").End(xlToLeft).Column
MyTable = Range(Cells(4, 1), Cells(LRow, LCol))
For i = 1 To UBound(MyTtable, 1)
If Branches.Range("C" & i) > Range("G1") Then 'Range("G1") = today formula
End If
Next i
End Sub
Thank you all!
Here's my interpretation of your request. If column "C" of the current row occurs before today then it will insert a row, copy the current row into that new row, and then increment the year on those dates.
Sub AddWorkingYearLine()
Dim i As Long
For i = Cells(Rows.count, "A").End(xlUp).row To 4 Step -1
'make sure it's not an "old entry"
If Cells(i, "A").Value2 <> Cells(i + 1, "A").Value2 Then
'if today occurs after "end date" then
If Date > CDate(Cells(i, "C").value) And Len(Cells(i, "C").Value2) > 0 Then
'insert row
Rows(i + 1).Insert Shift:=xlShiftDown
'copy row down
Rows(i + 1).value = Rows(i).value
'update dates
Cells(i + 1, "B").value = Cells(i, "C").value
Cells(i + 1, "C").value = DateAdd("yyyy", 1, CDate(Cells(i, "C").value))
End If
End If
Next i
End Sub
I have a spreadsheet each month that has 294 rows for each day of the month, excluding weekend dates. What I want to do is to be able to copy the range of rows for each Friday, and copy and paste the data for the missing Saturday and Sunday of each week. I have found a macro that finds missing dates and inserts a row for those dates, but do not know how to copy a range of cells while changing the date.
This is the macro I found in another topic that adds in rows for missing dates.
Sub insertMissingDate()
Dim wks As Worksheet
Set wks = Worksheets("Sheet1")
Dim lastRow As Long
lastRow = wks.Range("C2").End(xlDown).Row
'Work bottom up since we are inserting new rows
For I = lastRow To 3 Step -1
curcell = wks.Cells(I, 3).Value
prevcell = wks.Cells(I - 1, 3).Value
'Using a loop here allows us to bridge a gap of multiple missing dates
Do Until curcell - 1 = prevcell Or curcell = prevcell
'Insert new row
wks.Rows(I).Insert x1ShiftDown
'Insert missing date into new row
curcell = wks.Cells(I + 1, 3) - 1
wks.Cells(I, 3).Value = curcell
Loop
Next I
End Sub
Add this line:
wks.Rows(I - 1).Copy
Before this one:
wks.Rows(I).Insert xlShiftDown
Update (based on comments)
Sub AddDataWeekends()
Dim lRow As Long
lRow = Range("A" & Rows.Count).End(xlUp).Row
Dim x As Long
For x = lRow To 2 Step -294
If Weekday(Cells(x, 1), vbSunday) = 6 Then
Cells(x, 1).EntireRow.Copy
Cells(x, 1).Resize(294 * 2).Insert xlShiftDown
Cells(x + 1, 1).Resize(294).Value = Cells(x, 1) + 1
Cells(x + 1, 1).Offset(294).Resize(294).Value = Cells(x, 1) + 2
End If
Next
End Sub
I hope you can help me my VBA question. I would like to use a loop going down column A. Once a change is detected, I would like to insert a SUMIF formula in column C to total of column B if grouped the column A (Total offset to the right). A is already sorted. Kind of like Subtotal but without using the Subtotaling row.
A B C
1 2
1 6
1 3 11 =SUMIF(A:A,A3,B:B)
2 7
2 8 15 =SUMIF(A:A,A5,B:B)
3 8
3 6 14 =SUMIF(A:A,A7,B:B)
(without the added blank rows between 1 & 2 and 2 & 3 changes) I believe I am part of the way there with the following pieces of code pieces, but am having trouble getting to work together.
Sub SUMIF_Upon_Change()
Dim r As Long, mcol As String, i As Long
' find last used cell in Column A
r = Cells(Rows.Count, "A").End(xlUp).Row
' get value of last used cell in column A
mcol = Cells(r, 1).Value
' insert rows by looping from bottom
For i = r To 2 Step -1
If Cells(i, 1).Value <> mcol Then
Cells(n, 3).Formula = _
"=SUMIF(A:A,RC[-1],B:B)"
'AND / OR This added at the change row minus one row.
'Places formula in each adjacent cell (in column "D").
Range("C2:C" & Range("A" & Rows.Count).End(xlUp).Row).Formula = "=SUMIF(A:A,A3,BB)"
End If
Next i
End Sub
Any help will be much appreciated.
XLMatters, You pretty much have it. Your only major issue is that you seem to be mixing formula reference styles ("RC[-1]" and "A3"). You have to pick one or the other. Here is a working example of your code with a few minor modifications:
Sub SUMIF_Upon_Change()
Dim r As Long, mcol As String, i As Long
' find last used cell in Column A
r = Cells(Rows.Count, "A").End(xlUp).Row
' get value of last used cell in column A
mcol = Cells(r, 1).Value
For i = r To 2 Step -1
If Cells(i, 1).Value <> Cells(i + 1, 1).Value Then
Cells(i, 3).Formula = "=SUMIF(A:A,A" & i & ",B:B)"
End If
Next i
End Sub
If your heart is set on FormulaR1C1 style, here you go:
Sub SUMIF_Upon_ChangeRC()
Dim r As Long, mcol As String, i As Long
' find last used cell in Column A
r = Cells(Rows.Count, "A").End(xlUp).Row
' get value of last used cell in column A
mcol = Cells(r, 1).Value
For i = r To 2 Step -1
If Cells(i, 1).Value <> Cells(i + 1, 1).Value Then
Cells(i, 3).FormulaR1C1 = "=SUMIF(C1,RC1,C2)"
End If
Next i
End Sub
Should you have any other questions, just ask.
I'm working on a spreadsheet that has 17 sheets, with sheets 2-16 containing invoice data I am interested in.
As an example, if a person's name in column 4 of Sheets(2) appears in Sheets(1), then I want to sum the amount of money they have charged (which is found in column 10 of Sheets(2)). Spreadsheets 2-16 are laid out exactly the same, except they contain a different number of entries and the data is different.
There are three $ sums I am interested in computing and then displaying at the top of each sheet: two sums of money represent two different divisions, and the last is simply the total (w_sum, smb_sum, and total)
The problem I'm having is that every sheet displays the sums from Sheets(2), and not their own. However, when I remove the outer For loop and manually change the sheet number, I get the correct values. I hope I'm being clear with my question, and I would greatly appreciate any help. I just started playing around with VBA the other day, so I'm not too familiar with the syntax, but I think my logic is right or almost right.
Sub GetSums()
Dim i As Integer
Dim j As Integer
Dim w_sum As Currency
Dim smb_sum As Currency
Dim total As Currency
w_sum = 0
smb_sum = 0
total = 0
i = 15
For j = 2 To 17
Sheets(j).Activate
Do Until Cells(i, 6).Value = 0
If Not IsError(Application.Match(Cells(i, 4).Value, Sheets(1).Range("D2:D91"), 0)) Then
w_sum = w_sum + Cells(i, 10).Value
End If
If Not IsError(Application.Match(Cells(i, 4).Value, Sheets(1).Range("E2:E91"), 0)) Then
smb_sum = smb_sum + Cells(i, 10).Value
End If
total = total + Cells(i, 10).Value
i = i + 1
Loop
Cells(10, 4).Value = w_sum
Cells(11, 4).Value = smb_sum
Cells(12, 4).Value = total
Next j
End Sub
You can declare variable as worksheet:
Dim ws As Worksheet
Then instead of calling Sheets(j).Activate, you can bind ws to sheet number j:
Set ws = Sheets(j)
Then you can use ws.cell(i, 4).value instead of just cells(i, 4).value which tends to behave arbitrarily.
Hope this helps
This is my first post to stack overflow and my first online question about programming.
I am developing a program to record requests for projects (Work Orders) in a manufacturing plant. The current system is being removed due to the switch from Windows XP.
I am having trouble developing my numbering code.
The format of the code is:
YY - ######. I'm currently using:
.Cells(iRow, 1).Value = Format(Date, "yy") & " - " & Format(iRow - 1, "000000")
So that would input the Year and the "iRow" - 1 into the first column. iRow is determined using:
iRow = 2 'starting index for next empty WONum cell
With WORecordSheet
'Find the next empty WONum cell
Do While .Cells(iRow, 1).Value <> ""
.Cells(iRow, 1).Activate
iRow = iRow + 1
Loop
End With
It loops through each until an empty row is found, then inputs the number using the year and that specified row minus one into that cell.
The problem I'm having is with the year. When a new year comes, it needs to switch back to the first work order.... Such as:
14 - 001111
14 - 001112
14 - 001113
15 - 000001
15 - 000002
But, the problem is that the number is made using the row, so it won't restart with a new year. I know that I will need another variable that either adds 1 to the previous number if the year is the same or loops through just the rows of the same year until a new row is found and that is the number put in for the work order number, but the empty row to input the number into should be decided the same way as before, with the iRow loop.
I do not know how I could determine the year of the previous entry... Could you somehow separate the value into the two parts of "YY" and "######"? And run an if statement that if the "YY" is the same as the current year then it adds 1 to the "######"?
Thanks for any suggestions!
UPDATE: I have created a block of code that works. It is based off of the response from #user1759942 . However, I did reference the other responses to dim variables and use the "Right" function properly. Here is the updated code:
Dim iRow As Long
Dim yr As Long
Dim lCodeNum As Long
WORecordSheet.Activate
iRow = 2 'starting index for next empty WONum cell
lCodeNum = 1 'starting index for last 6 digits of wonum
With WORecordSheet
'Find the next empty WONum cell
Do While .Cells(iRow, 1).Value <> ""
.Cells(iRow, 1).Activate
iRow = iRow + 1
Loop
yr = Left(.Cells(iRow - 1, 1).Value, 2)
If yr = Format(Date, "yy") Then
lCodeNum = Right(.Cells(iRow - 1, 1).Value, 6) + 1
Else
lCodeNum = 1
End If
End With
And later on:
.Cells(iRow, 1).Value = Format(Date, "yy") & " - " & Format(lCodeNum, "000000")
you can do exactly what you thought. Separate the YY from the rest and examine that.
have a variable - dim yr as string to save the year, and I'd use a separate variable for putting the number: dim lCodeNum as long and in the while loop set those variables too
dim yr as string
iRow = 2 'starting index for next empty WONum cell
lCodeNum = 1
With WORecordSheet
'Find the next empty WONum cell
yr = left(.cells(iRow,1).value, 2) 'gets the first 2 characters in the cell
Do While .Cells(iRow, 1).Value <> ""
.Cells(iRow, 1).Activate
iRow = iRow + 1
if not left(.cells(iRow, 1).value, 2) = yr then
lCodeNum = 1
else
lCodeNum = lCodeNum + 1
end if
yr = left(.cells(iRow,1).value, 2)
Loop
End With
then when you assign the value to the empty cell you can do:
.Cells(iRow, 1).Value = Format(Date, "yy") & " - " & Format(lCodeNum, "000000")
so the way above, you're using irow to loop over every row, and to reference the cells, but using lCodeNum as the number, thus it resets to 1 every time a new year is encountered.
you could use irow instead of lcodenum, but then you could only put 1 if a new year was encountered, and then the numbers would pick up where they left off, so you'd end up with like
14 - 000144
14 - 000145
15 - 000001
15 - 000147
This isn't a 100% complete answer, but hopefully it will give you everything you need to apply it to your own program. Also, this isn't the only way to address this, but it is one way. Hopefully it will give you a good enough nudge in the right direction...
It's simple enough to get the last two digits of the current year in VBA doing something like:
Dim yearDigits As Long
yearDigits = Right(Year(Now), 2)
now that you know the current year's last 2 digits, you can compare it to the some data string like YY - ###### by doing something close to:
Dim invoice As String
yearDigits = Right(year(Now), 2)
invoice = "13 - 001111"
invoiceYear = Left(invoice, 2)
tying it together may look something like:
Sub test()
Dim yearDigits As Long
Dim invoice As String
Dim invoiceYear As Long
Dim equalYear As Boolean
yearDigits = Right(year(Now), 2)
invoice = "13 - 001111"
invoiceYear = Left(invoice, 2)
equalYear = yearDigits = invoiceYear
MsgBox "Current Year = " & yearDigits & ". Invoice Year = " & invoiceYear & ". Are they equal? " & equalYear
End Sub
If this doesn't help, or you need some help applying it to your code, please post back and I'll give you some more nudges.
Good luck!
This should place a new number code in column A each time it is run. It should re-start the sequencing on change of year:
Sub FillId()
Dim N As Long, Prev As String, PrevYr As Long, PrevNum As Long
Dim Yr As Long, M As Long
If Range("A1").Value = "" Then
Range("A1").Value = Mid(Year(Date), 3) & " - " & "000001"
Exit Sub
End If
N = Cells(Rows.Count, "A").End(xlUp).Row
Prev = Cells(N, "A").Value
PrevYr = CLng(Mid(Prev, 1, 2))
PrevNum = CLng(Mid(Prev, 6))
Yr = CLng(Mid(Year(Date), 3))
If Yr <> PrevYr Then
M = 1
Else
M = PrevNum + 1
End If
Cells(N + 1, "A").Value = Mid(Year(Date), 3) & " - " & Format(M, "000000")
End Sub