How to sum up rows in excel using VBA - vba

I'm creating my first module, using VBA, and not sure how to sum up rows. I was wondering if someone could help me. I have a file of transactions, picture attached:
I'm trying to insert a break (blank row) in between date groups (group all transaction from a specific date), and then a sum of each total in the break under each column for the corresponding date. My code is as follows, but I'm stuck on how to create the sum as I'm not sure the syntax. Here is the code I came up with:
Sub InsertRowsBetweenDates()
'
' InsertRowsBetweenDates Macro
' Insert Rows in between two dates that are not equal
'
Dim x As Integer
Dim y As Integer
Dim row1 As Range
Dim row2 As Range
Dim t As Integer 'tracking how many cells to add together
'define x as cell row value
x = 2
'define y as cell row value
y = 3
'start tracker at 0
t = 0
'row 1 and row 2 get their values
Set row1 = Cells(x, 4)
Set row2 = Cells(y, 4)
'Do until there are no more entries in the worksheet (or really until row 1 has no value)
Do Until row1.Value = False
x = x + 1
y = y + 1
Set row1 = Cells(x, 4)
Set row2 = Cells(y, 4)
t = t + 1
'If row 1 and 2 don't equal each other, insert a row above row 2
If row1 <> row2 Then
row2.EntireRow.Insert Shift:=xlDown
'sum up t rows for subtotal and tax [THIS IS WHAT IM STUCK ON]
'skip the break
x = x + 2
y = y + 2
Set row1 = Cells(x, 4)
Set row2 = Cells(y, 4)
t = 0
End If
Loop
End Sub
As you can see, I got the break to work, albeit it only works for this file as the rows and column positions are hardcoded, but its a start. At this point I have a tracker to track how many rows have been counted, and I think I just need to insert code to sum up the rows. How would I go about achieving this?

I think you're heading completely at the wrong path.
I wouldn't do that unless I totally and utterly HAVE TO
Why?
Because you're putting the data together with the report. What happens when someone need to insert a row? What happens when someone has to maintain your code?
Look at the following options:
1. Use the source as a table and summarize with a pivot table
2. Add a column and use the SUMIF function
These ways you avoid using VBA altogether and still manage to get the reports you need. Good luck!

Related

Multiply columns of Excel table using VBA

I am trying to multiply values in two columns of a table and display it in another column.
Since this process has to be repeated for multiple columns, how should I go about referencing columns using column headers? Any help would be appreciated.
The logic would be as follows:
ListColumns(x) = ListColumns(x - 1) * ListColumns(x - 3)
This is within a loop where the value of x changes.
There are multiple ways of achieving what you are after.
1st: Let's suppose x = 4, so you want to multiply column A and C and store result in D column. Simply put formula = A1 * C1 in D1 and drag it all the way down.
2nd: Using VBA, more generic:
Sub MultiplyCoulmns()
Dim resultColumn As Long 'this is x
resultColumn = 4 'just for example, change it to whatever you need
'alternatively, specify column header
Dim header As String
header = "SomeColumn"
resultColumn = Application.WorksheetFunction.Match(header, Range("A1:Z1"), 0)
Dim i As Long, lastRow As Long
lastRow = Cells(Rows.Count, resultColumn).End(xlUp).Row
For i = 1 To lastRow
Cells(i, resultColumn) = Cells(i, resultColumn - 1) * Cells(i, resultColumn - 3)
Next
End Sub

Inserting blank rows after specific rows - VBA

This is a code I came up with until now
Sub RunMe()
Dim x As Integer
Dim sv As Integer
x = 11
sv = Range("MyTable").Rows.Count
Do
Rows(x).Resize(sv).Insert
x = x + sv
Loop Until IsEmpty(Cells(x, "A"))
End Sub
So basically this is supposed to insert blank cells in row 11. But the problem is it just adds blank cells at the end of the table instead after row 11. Is there any way to fix this? I am a pure beginner at VBA, this is my first time experimenting with it. Any help will be appreciated.
This could be achieved by:
LastRow = Sheet2.Cells(Sheet2.Rows.Count, "A").End(xlUp).Row
Sheet2.Range("A1:K" & LastRow).Copy 'amend to include the number of columns, also change 1 to 2 if using header and don't want to include them
Sheet1.Rows("11:11").Insert Shift:=xlDown
This will not create empty rows, but instead it will insert all the rows with data into Sheet1 Row 11.
So count the number of rows on Sheet2, then select the range to be copied, and finally inserting into row 11 of Sheet1.
UPDATED:
Sheet2.Range("MyTable").Copy
Sheet1.Rows("11:11").Insert Shift:=xlDown
Try this, for me it works quite ok:
Sub RunMe()
Dim x As Integer
Dim sv As Integer
x = 11
sv = Range("MyTable").Rows.Count + 1
Rows(x).Resize(sv).Insert
End Sub
If the table is with 23 rows, it inserts 23 empty rows after the 10. row.

How to shrink the data from multiple columns into one column

hopefully someone will be able to help me. I need to write a query, which would shrink the data from multiple columns (in my case from columns A:H) into one column.
The original file looks like this:
I need to shrink the data one by one by rows. I mean, the query has to check the first row and take the data (name), and put it into "a new column" then check the second column and do the same, and continue like this one by one. The table has 170 rows.
I found a query that is shrinking the data from multiple columns into one column but in another order than I need. The query is taking as first all data from a column A and putting it into "a new column", then taking all data from a column B and putting it into "a new column" under the data from the previous column (column A).
This is the query I tried to apply:
Please could somebody help me with it? I have to admit that I have not use UBound and LBound functions and I am getting pretty lost here. :(
I will be thankful for any advise how to adjust this query.
Many thanks in advance! :)
Try this. I'm first setting your range to an array. I then loop through the array and 'slice' each row using Application.Index. It then Joins all the content in that row together before Trimming the whitespace left over from either end. This leaves me with the one value in my results array (tmp). The code then clears your source data before leaving all your data in one column.
Sub CombineColumns()
Dim rng As Range
Dim tmp As Variant, vaCells As Variant
Dim i As Long
Set rng = Sheets("DATA").Range("A2:H200")
vaCells = rng.Value2
ReDim tmp(LBound(vaCells) To UBound(vaCells))
For i = LBound(tmp) To UBound(tmp)
tmp(i) = Trim(Join(Application.Index(vaCells, i, 0)))
Next i
With rng
.ClearContents
.Cells(1).Resize(UBound(tmp)).Value2 = Application.Transpose(tmp)
End With
End Sub
LBound returns the lowest position in the array (usually 0 or 1) and UBound returns the highest
I think something like this
for i = 1 to 170
for y = 1 to 8
if worksheets("trainers").cells(i,y).value <> "" then
worksheets("output").cells(i,1).value = worksheets("trainers").cells(i,y).value
exit for
end if
next y
next i
or on same sheet
For i = 1 To 170
Z = 0
For y = 1 To 8
If Cells(i, y).Value = "" Then
Cells(i, y).Delete Shift:=xlToLeft
Z = Z + 1
If Z <= 8 Then y = y - 1
End If
Next y
Next i

Removing loops to make my VBA macro able to run on more data

in my data there are more than a thousand different six digit numbers that are reoccurring in no specific pattern. I need to find all six digit codes that exist in column A and for each number. For example 123456, then find summarize the value in column B for every row that has 123456 in column A. My code is not very effective but the runtime is not a problem if I run with only 10 rows. However, in the real data sheet there are 80 000 rows and my code will take to much time. Can someone help me edit my code but removing certain loops within loops or some stop conditions. I'm new to VBA and can't do it myself in the limited time I have.
Sub Test2()
Dim summa As Long
Dim x As Long
Dim condition As Boolean
Dim lRows As Long
Dim k1 As Integer
Dim i As Long
x = 1
Worksheets("Sheet1").Activate
For i = 100000 To 999999
k1 = 1
lRows = 10
condition = False
While k1 <= lRows
If Cells(k1, "A").Value = i Then
condition = True
End If
k1 = k1 + 1
Wend
If condition = True Then
Cells(x, "F").Value = Application.SumIf(Range("A:A"), CStr(i), Range("B:B"))
Cells(x, "E").Value = i
x = x + 1
End If
Next i
MsgBox "Done"
End Sub
You don't need VBA for this task. Follow these steps.
Insert a blank column C in a copy of the original data sheet.
Insert a SUMIF formula, like =SUMIF(A:A, A2, B:B) in C2 and copy all the way down.
Now all items 123456 will have the same total in column C
Copy column C and Paste Values (to replace the formulas with their values).
Delete column B.
Remove duplicates.

VBA Excel word search and copying formulas

I'm searching for a VBA macro for Excel, which can detect the word "mean", in column A. After this it would copy the yellow row with the formula in C to J.
The formula counts the average from one row after the last "mean" to the next =AVERAGE (C1323:C1437)
after every sixth mean there also needs to be Area and 150 copyied two rows after mean and I and J Need to be changed. Consequently I and J would refer to the cell A1441 in this case (=G1439/C1439*$A$1441) till the end of the file.
I'm not quite sure if it's easy or not but I'm totally overchallenged. I would be very thankful for help.
Sub Makro1()
'
' Makro1 Makro
'
' Tastenkombination: Strg+q
strSearchWord = "Mean"
i = Application.WorksheetFunction.CountIf(Range("A:A"), strSearchWord)
Y = 2
For x = i To 0
i = Application.WorksheetFunction.Match(strSuchWort, Range("A:A"), 0)
Range("C" & i).Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "=AVERAGE(R[-147]C:R[-1]C)" ' that's still wrong, should be something like i-y?
Selection.AutoFill Destination:=Range("C" & i:"J" & i), Type:=xlFillDefault
Range("CY:JY").Select
i = Y
'for each fifth i
'Range("A" & i + 3).Select
' ActiveCell.FormulaR1C1 = "=RC[-2]/RC[-6]*R2159C1"
Next x
End Sub
it's still wrong, but my first draft.
#stucharo the Area correction is difficult to describe I've added a better Picture with formulas. I hpe that now it's understandable
If your line ActiveCell.FormulaR1C1 = "=AVERAGE(R[-147]C:R[-1]C)" needs to change the number of rows betwen means each time then you'll need to add a variable as you comment suggests. Also, just writing the string to the cells value (ActiveCell.Value) means that you will see it written as a formaula when you click the cell in the workbook (and it'll highlight the range etc.). You could try replacing it with:
ActiveCell.Value = "=AVERAGE(R[" & i - Y & "]C:R[-1]C)"
although since I can't see the first row of your sheet I'm not certain that'll give you the correct range of rows each time.
If your row number is likely to change and you are copying over the same number of columns each time then it might also be just as easy to write the formula directly to cells within a loop, rather than explicitly copying it.
Adding text after every 6th "mean" would require you to keep count of how many means had passed so far. This can be done by incrememnting a counter variable and using the Mod operator will tell you the remainder after a division. Therefor numberOfMeans Mod 6 will give you the remainder when divided by 6 and when this equals zero you know you have a multiple of 6. I've tried to capture all this into the code below.....
Sub Test()
Application.ScreenUpdating = False
Dim startRow As Integer
startRow = 2
Dim endrow As Integer
endrow = Range("A2").End(xlDown).row
Dim lastMeanRow As Integer
lastMeanRow = startRow - 1
Dim areaRow as Integer
areaRow = lastMeanRow + 3
Dim meanCounter As Integer
meanCounter = 0
Dim avgColHeight As Integer
Dim col As Integer
Dim row As Integer
'Check each row in the sheet
For row = startRow To endrow
'Cols i and j in every row need to be modified
For col = 9 To 10
Cells(row, col).Value = "=RC[-2]/RC[-6]*R" & areaRow & "C1"
Next col
'If column 1 of that row contains "mean" then
If Cells(row, 1).Value = "mean" Then
'Calculate the column height to average over....
avgColHeight = row - lastMeanRow - 1
'...and loop through each of the columns....
'(including i and j to add average)
For col = 3 To 10
'....inserting the averaging formula.
Cells(row, col).Value = "=AVERAGE(R[-" & avgColHeight & "]C:R[-1]C)"
Next col
'Then increment the counter to keep track of the number of means
meanCounter = meanCounter + 1
'If the number of means is a multiple of 6 then
If (meanCounter Mod 6 = 0) Then
'insert the "Area" and "150" strings
Cells(row + 2, 1).Value = "Area"
Cells(row + 3, 1).Value = "150"
areaRow = row + 3
End If
'Finally change the lastMeanRow to the mean row we have just processed.
lastMeanRow = row
End If
'Do it again until we reach the end of the data
Next row
Application.ScreenUpdating = True
End Sub
I also noticed your point on the value of area changing periodically. Writing this programatically, as above, will aloow you to add some logic over the value of "Area" and when it changes.
You clearly have a long list of data and want to automate the creation of the rows and formulas you describe.
It is possible write VBA to scan through the data and modify the formulas etc but first I would question if this is the best approach to give you what you need.
Excel has a feature called "pivot tables" which essentially allows you to summerise data in a list.
for instance if the list had one row for each city in the world and gave the population in the city, and a column gave which country it was in. A pivot table could be used to create the average population for a country of the countries cities. I suspect you are doing this sort of thing.
If you don't know about pivot tables you should find out about them. See here
In your case your mean row is summeriseing data in the rows above it. To use pivot tables you would have to have a column that defined which group each row is in. You pivot table would sue this column as a row summary and you would then create the average for all the other column.
#Nathalie. It's hard to help without knowing more. eg Is the data delivered with the mean text already inserted. It looks like column A has a number the represent the row number within the group (and this could be used by a formula to create the "Group Name" column you need for pivot tables.
You can get the pivot tables to do the area adjustment by:
Creating a new set of columns which contains formulas that cause the values in columns C to J to be copied except for when it is the 6th set of data in which case you adjust the values in C to J accordingly).
You probably need to introduce columns that:
A. give the "group name"
B. give a count of which group it is in so every 6th you can do the adjustment you need.
4 by using pivot tables and basic techniques you will find it easie rot update the refresh the data, should you need to.