I have a small script which arranges a budget into a monthly format another software accepts. The script works mostly fine, except that some numbers aren't divisible by 12. I'm having trouble correcting that.
The table originally looks something like:
..and when the script is run, the table turns to:
..for a total sum of 12 999.60 - not the original 13 000.00. The difference may look a bit trivial, but the numbers are in tens of thousands so they do unfortunately matter a lot.
I did think I could account for the rounding error though by taking the total rounded number and subtracting the original number in the last entry, which may sound like a clunky solution but it's OK, but this gave the following result:
..which is a total of 13 003.60. I could be going about this all wrong and the solution may be stupid simple, for which I ask you to forgive my incompetence, but this is the code with the attempted correction:
'For each budget post..'
For Each row In rng.Rows
Dim i As Long
'Decimal count var'
Dim countDec As Long
countDec = 0
'Repeat twelve times'
For i = 1 To 12
'Test if row is empty'
If Len(Range("A" & x).Value) > 0 Then
'Add the current periods number to the variable..'
countDec = countDec + Round(Range("D" & x).Value / 12, 1)
'New values to cells'
Cells(j, 6).Value = Range("A" & x).Value 'Account'
Cells(j, 7).Value = i 'Period value +1'
Cells(j, 8).Value = Range("C" & x).Value 'Cst'
'Correct decimal on 12th iteration'
If i = 12 Then
countDec = countDec - Range("D" & x).Value 'Count the difference between the total periods and the original value'
Cells(j, 9).Value = Round(Range("D" & x).Value / 12, 1) + countDec '1/12th plus sum of decimal difference'
ElseIf i <> 12 Then
Cells(j, 9).Value = Round(Range("D" & x).Value / 12, 1) 'If not last iteration, just print rounded period value'
End If
j = j + 1
End If
Next i
x = x + 1
Next row
Try this If i = 12 clause:
If i = 12 Then
Cells(j, 9).Value = Range("D" & x).Value - Round(Range("D" & x).Value / 12, 1) * 11
Related
I have an excel document that initially has 1 tab like this:
When I run the "master" macro, it:
Deletes some columns
Adds a row at the top with numbers
Adds a blank sheet called Output
Takes the raw data tab, pastes it in the "output" tab and transposes it from wide to long (all those macros work perfectly)
Finally it counts chunks of rows in the output tab and inserts two rows with summary stats, like so:
So far, this is mostly the behavior I'd like. The 65 is in the correct spot. Id like it to show "91" right underneath that (the sum of the entire column so far), but at least the 65 is correct.
The more pressing problem is some of the following summary rows. For instance the very next summary rows have 91 where it should be, but an incorrect blank above it:
And then the following summary rows should be 100,100 and instead it says 0,91:
and the summary row after that should be 100,100 but is 0,191!
I'm less familiar pasting excel VBA onto stack (usually on the R side of things), but I think the problem is somewhere in this macro:
'ADD THE EXCEL FORMATTING********************************************************************
Sub format()
Dim lastRow As Long, rawRow As Long, rawCol As Long, writeRow As Long
'count total number of rows
lastRow = Sheets("Output").Cells(Rows.Count, 1).End(xlUp).Row
'set starting places, first row with info is 3 while trouble shooting but 2 normally
x = 1
Row = 2
'Set sum counter to add up all no cost center values
total_RE_sum = 0 'total research effort actual
total_REp_sum = 0 'total research effort previous
total_REb_sum = 0 'total research effort budgeted
total_E_sum = 0 'total effort actual
total_Ep_sum = 0 'total effort previous
total_Eb_sum = 0 'total effort budgeted
'Start loop*****************************************************************************
'where it finds ROW = 20 inserts 2 rows below
For x = 1 To lastRow
'For x = 1 To 66
If Cells(Row, 11) = 20 Then
Rows(Row + 1).EntireRow.Insert
Rows(Row + 1).EntireRow.Insert
' Cells(Row + 1, 8).NumberFormat = "0%"
' Cells(Row + 1, 9).NumberFormat = "0%"
' Cells(Row + 1, 10).NumberFormat = "0%"
' Cells(Row + 2, 8).NumberFormat = "0%"
' Cells(Row + 2, 9).NumberFormat = "0%"
' Cells(Row + 2, 10).NumberFormat = "0%"
Cells(Row + 1, 7) = "Total Research Effort"
Cells(Row + 2, 7) = "Total Effort"
' insert reseach effort previous and actual
Cells(Row + 1, 8) = total_REb_sum
Cells(Row + 1, 9) = total_REp_sum
Cells(Row + 1, 10) = total_RE_sum
' insert total effort previous and actual
Cells(Row + 2, 8) = total_Eb_sum
Cells(Row + 2, 9) = total_Ep_sum
Cells(Row + 2, 10) = total_Ep_sum
'2 rows are added in this step because the new row jsut added in this step adds to the increment
Row = Row + 2
'reset sum to 0 because I moved to a new person
total_RE_sum = 0 'total research effort actual
total_REp_sum = 0 'total research effort previous
total_REb_sum = 0 'total research effort budgeted
total_E_sum = 0 'total effort actual
total_Ep_sum = 0 'total effort previous
total_Eb_sum = 0 'total effort budgeted
ElseIf Row >= 7 And Row <= 20 Then
total_RE_sum = total_RE_sum + Cells(Row, 10).Value 'total research effort actual
total_REp_sum = total_REp_sum + Cells(Row, 9).Value 'total research effort previous
total_REb_sum = total_REb_sum + Cells(Row, 8).Value 'total research effort budgeted
total_E_sum = total_E_sum + Cells(Row, 10).Value 'total effort actual
total_Ep_sum = total_Ep_sum + Cells(Row, 9).Value 'total effort previous
total_Eb_sum = total_Eb_sum + Cells(Row, 8).Value 'total effort budgeted
Row = Row + 1
Else
total_E_sum = total_E_sum + Cells(Row, 10).Value 'total effort actual
total_Ep_sum = total_Ep_sum + Cells(Row, 9).Value 'total effort previous
total_Eb_sum = total_Eb_sum + Cells(Row, 8).Value 'total effort budgeted
Row = Row + 1
End If
Next
End Sub
I'm not sure at all where the macro went wrong, I wasn't the original author. Thank you!
Notes:
I am only appending for the solution looked as stated,on a personal note I think the whole logic needs to be revised. The problem stated could be better worded for others to understand the logic without the need of downloading the file. In relation to selections used in the pre process look at this topic to avoid selection. Bottom line: You are right, the module format is the one needed to be fixed, I changed the whole logic for it
Demo:
Code:
Sub format_alternative()
Const NumRowsToAppend As Long = 20
Dim NumTotalRows As Long
Dim TotalCyclesToPerfom As Long
Dim CounterCyclesToPerform As Long
Dim NumRowsAppended As Long
Dim IsFixLast As Boolean
Dim NumRowResearchEffort As Long
Dim NumRowTotalEffort As Long
With Sheets("Output")
NumTotalRows = .Cells(.Rows.Count, 1).End(xlUp).Row - 1
TotalCyclesToPerfom = NumTotalRows / NumRowsToAppend
'It means for last cycle there are not enough rows to do it as for others, so we need to append for that
IsFixLast = IIf(NumTotalRows Mod NumRowsToAppend <> 0, True, False)
NumRowsAppended = 1
For CounterCyclesToPerform = 1 To TotalCyclesToPerfom
If CounterCyclesToPerform = TotalCyclesToPerfom And IsFixLast = True Then ' 1. If CounterCyclesToPerform = TotalCyclesToPerfom And IsFixLast = True
'I'm going to leave this scenario for you to try to understand the logic and when it happens you fix it accordingly
Else ' 1. If CounterCyclesToPerform = TotalCyclesToPerfom And IsFixLast = True
NumRowResearchEffort = (NumRowsToAppend * CounterCyclesToPerform) + 1 + NumRowsAppended
NumRowTotalEffort = (NumRowsToAppend * CounterCyclesToPerform) + 2 + NumRowsAppended
End If ' 1. If CounterCyclesToPerform = TotalCyclesToPerfom And IsFixLast = True
.Rows(NumRowResearchEffort & ":" & NumRowTotalEffort).Insert
.Cells(NumRowResearchEffort, 7) = "Total Research Effort"
.Cells(NumRowTotalEffort, 7) = "Total Effort"
' insert reseach effort previous and actual. I changed for a formula so it's easier for the user to see what's going on calculations
.Cells(NumRowResearchEffort, 8).Formula = "=SUM(H" & NumRowResearchEffort - 11 & ":H" & NumRowResearchEffort - 1 & ")"
.Cells(NumRowResearchEffort, 9).Formula = "=SUM(I" & NumRowResearchEffort - 11 & ":I" & NumRowResearchEffort - 1 & ")"
.Cells(NumRowResearchEffort, 10).Formula = "=SUM(J" & NumRowResearchEffort - 11 & ":J" & NumRowResearchEffort - 1 & ")"
' insert total effort previous and actual. I changed for a formula so it's easier for the user to see what's going on calculations
.Cells(NumRowTotalEffort, 8).Formula = "=SUM(H" & NumRowResearchEffort - NumRowsToAppend & ":H" & NumRowResearchEffort - 1 & ")"
.Cells(NumRowTotalEffort, 9).Formula = "=SUM(I" & NumRowResearchEffort - NumRowsToAppend & ":I" & NumRowResearchEffort - 1 & ")"
.Cells(NumRowTotalEffort, 10).Formula = "=SUM(J" & NumRowResearchEffort - NumRowsToAppend & ":J" & NumRowResearchEffort - 1 & ")"
NumRowsAppended = NumRowsAppended + 2
Next CounterCyclesToPerform
End With
End Sub
I am making a list of financial cost centres of different departments of a company every time it updates in the sheet "Union" i have to update it in number of sheets so I am trying to develop a vba to do that but failed to get desire results, since I am new to vba programming so any favour will just like to fetch fish into the water.
Here is the source sheet "Union"
It goes on till column45 like this having costcentres detail of individual departments.
Now the sheet I want to update is "REC_INT"
It also goes around 250 rows.
You see cost centres are updated in 1st and 3rd but in 4th cost centre 1002-94q not updated and similary more when we go down, moreover when I run the vba again it will update the updated costcentres again and 1002-610 will appear two times here similarly 102-60001.
Sub CostCentresUpdates()
Dim i As Long
Dim x As Long
Dim j As Long
Dim z As Long
Dim q As Long
Dim a As Long
Shex = 200
For i = 10 To Shex Step 1
For j = 1 To 50 Step 1
If Worksheets("REC_INT").Cells(i, 3).Value = Worksheets("Union").Cells(1, j).Value Then
For z = 2 To 20 Step 1
For x = i + 1 To 20 Step 1
If IsEmpty(Worksheets("Union").Cells(z, j).Value) Then
GoTo y
End If
If Worksheets("Union").Cells(z, j).Value = Worksheets("REC_INT").Cells(x, 4).Value Then
GoTo q
End If
If Worksheets("Union").Cells(z, j).Value = "" Then
GoTo a
End If
Worksheets("REC_INT").Rows(x + 1).Insert shift:=xlShiftDown
Worksheets("REC_INT").Rows(x).EntireRow.Copy _
Destination:=Worksheets("REC_INT").Range("A" & Worksheets("REC_INT").Rows.Count).End(xlUp).Offset(x - 1)
Worksheets("REC_INT").Cells(x + 1, 3).Value = ""
Worksheets("REC_INT").Cells(x + 1, 18).Value = ""
Worksheets("REC_INT").Cells(x + 1, 19).Value = ""
Worksheets("REC_INT").Cells(x + 1, 20).Value = ""
Worksheets("REC_INT").Cells(x + 1, 4).Value = Worksheets("Union").Cells(z, j).Value
Next x
q:
Next z
End If
a:
Next j
y:
Next i
End Sub
In an excel Sheet, I have two colomns A & B (filled with text). I need to find for every same value in A, the part of the text in B that is similar.
Example below:
the pictures named product_1000.jpg have in common "thecat_" which needs to be given in the third colomn.
How to find the colomn C automatically? (Excel formula or VBA).
Note: My Table has around 40k lines.
I found my own answer thanks to the linked question of danieltakeshi's comment
Sub SerieNames()
Dim LastRow As Long
LastRow = sheets(1).Range("A" & Rows.Count).End(xlUp).Row
For a = 2 To LastRow
If Cells(a, 1).Value = Cells(a - 1, 1).Value Then
For i = 1 To Len(Cells(a - 1, 3))
If (Left(Cells(a, 2), i) <> Left(Cells(a - 1, 3), i)) Then
Cells(a, 3).Value = Left(Cells(a - 1, 3), i - 1)
Exit For
End If
Next i
If Cells(a, 3).Value = "" Then
Cells(a, 3).Value = Cells(a - 1, 3).Value
End If
Else: Cells(a, 3).Value = Cells(a, 2).Value
End If
Next a
End Sub
This Code is putting in the colomn C the longest common string starting from the left side.
After that I only needed to find the last result of every serie in the colomn C to find my answer. This can be done with formula just by counting the shortest string result of C for every serie.
Note: The colomn A has to be sorted beforehand, otherwise the code will not work.
I'm trying to combine the data from a date column and a time column. I'm using the following code:
Sub Concat()
Dim lRow As Long
lRow = Range("A" & Rows.Count).End(xlUp).Row
For i = 2 To lRow
Cells(i, 10) = Cells(i, 6) & " " & Cells(i, 7)
Cells(i, 11) = Cells(i, 8) & " " & Cells(i, 9)
Next I
Cells(1, 9).Copy
Cells(1, 10).PasteSpecial Paste:=xlPasteFormats
Cells(1, 11).PasteSpecial Paste:=xlPasteFormats
Cells(1, 10) = "Request Time"
Cells(1, 11) = "Validation Time"
End Sub
the result I get is this:
Input data:
Creation_Date Creation Time Change Date Change Time Request Time Validation Time
01/23/2017 8:20:10 01/23/2017 8:20:10 1/23/2017 0.347337962962963 1/23/2017 0.347337962962963
The time turns into a decimal that cannot be converted back to a time. before concatenate function, the date column is formatted for date and the time column is formatted to time.
Please help.
The underlying data type of a date/time format is most likely a 64-bit floating. I would suggest converting to String the values before concatenating and after that, applying the datetime format.
You could change your loop as follows:
For i = 2 To lRow
Cells(i, 10) = Cells(i, 6) + Cells(i, 7)
Cells(i, 11) = Cells(i, 8) + Cells(i, 9)
Cells(i, 10).NumberFormat = "m/dd/yyyy h:mm:ss"
Cells(i, 11).NumberFormat = "m/dd/yyyy h:mm:ss"
Next I
Of course, the formatting of columns J & K could be done in Excel, rather than in code, if that was easier for you.
The important thing is to just add the date and the time, not to try and create a string with the values joined together. (The time 8:20:10 is just a number which is equal to 8/24 + 20/24/60 + 10/24/60/60, i.e. 0.347337962962963, which is why the resultant string was being created as 1/23/2017 0.347337962962963 and, once it was a string then Excel is going to have a hard time treating it as anything else.)
I have data in excel that looks like this
{name} {price} {quantity}
joe // 4.99 // 1
lisa // 2.99 // 3
jose // 6.99 // 1
Would it be hard to make a macro that will take the quantity value ("lisa // 3.99 // 3") and add that many rows below it's current location. It would know which rows to copy, and how many rows to insert based on on the quantity column.
Thanks for reading, and feedback is helpful.
This will do what you want, it polls through from the bottom up, if it encounters a number in C and it is > 1 then it will insert the number of rows equal to column C number - 1 then copy the data from the host row.
This will give you 4 equal rows where there is a 4 in column C, I think that is what you were after yes? If you want to ADD the number of rows equal to column C (So a value of 4 would add 4 NEW rows making the total count for that entry become 5) then let me know, it will be simple enough to change this
Sub InsertRowsByQTY()
Dim X As Long
For X = Range("A" & Rows.Count).End(xlUp).Row To 1 Step -1
If IsNumeric(Range("C" & X).text) Then
If Range("C" & X).Value > 1 Then
Rows(X + 1).Resize(Range("C" & X).Value - 1, Columns.Count).Insert
Range("A" & X + 1).Resize(Range("C" & X).Value - 1, Cells(X, Columns.Count).End(xlToLeft).column).Value = Range("A" & X).Resize(1, Cells(X, Columns.Count).End(xlToLeft).column).Value
End If
End If
Next
End Sub
Another method :
Sub insert()
Dim lastrow As Integer, frow As Integer
lastrow = Range("C65536").End(xlUp).Row
frow = 0
For i = 2 To lastrow
If Cells(i, 3) > 1 Then
frow = frow + Cells(i, 3)
End If
Next i
For i = 2 To lastrow + frow
If Cells(i, 3) <> 1 Then
nr = Cells(i, 3)
Rows(i + 1 & ":" & i + nr).Select
Selection.insert Shift:=xlDown
Rows(i & ":" & i + nr).Select
Selection.FillDown
i = i + nr
End If
Next i
End Sub