I am creating a new macro to enable a custom report from a download we use bi-weekly.
I recorded the macro using one of the downloads, This has given me everything I need, except for my last piece.
I need to find the last row, go one row down, and sum columns J, K, L, and M. Then in column "I" the word "Total" should be on that same row.
To be clear, I want to sum column J from J2:Jxxx, where xxx is the last row.
Each time we download this report, the number of lines will vary, so I cannot use static row numbers as part of the formula.
I need to know how to write this, I have searched several forums and Excel sites to get this, but nothing has worked. Also, can this be done in such a way that one set of code will cover all the columns, or will it have to be repeated for each column?
Here is the code I have (keep in mind this is now a hodge-podge from trying out various helps I found on-line throughout the day):
EndRowI = Range(I65536).End(xlUp).Row
.Sheets(x).Range("I" & EndRowI + 1).Formula = "=SUM(I2:I" & EndRowI & ")"
EndRowH = Range("H" & Rows.Count).End(xlUp).Row
Range("H" & LR + 1).FormulaR1C1 = "Total"
For what it's worth, the name of my sheet is "combined" which is an earlier step in my macro.
Thank you!
*Please correct your worksheet name as my example refers to Sheet1 in ThisWorkbook
This code finds the biggest row number of J:M columns range and then sums each column and shows them at that biggest row number with their TOTAL title in H column. (As your question was not so clear I tried to figure out this based on your comments.)
Option Explicit
Sub SubUntilLastRow()
Dim CurCal As XlCalculation
Dim wb As Workbook, ws As Worksheet, colsLastRow As Long
Dim cols As Variant, SumCols As Long, colsArray As Variant
Dim biggestRow As Long
Application.ScreenUpdating = False
CurCal = Application.Calculation
Application.Calculation = xlCalculationManual
biggestRow = 1
Set wb = ThisWorkbook
Set ws = wb.Sheets("Sheet1")
colsArray = Array("J", "K", "L", "M")
For Each cols In colsArray
colsLastRow = ws.Cells(Rows.Count, cols).End(xlUp).Row
If colsLastRow > biggestRow Then
biggestRow = colsLastRow + 1
End If
Next cols
For Each cols In colsArray
colsLastRow = ws.Cells(Rows.Count, cols).End(xlUp).Row
ws.Cells(biggestRow, cols).Formula = "=SUM(" & cols & "2:" & cols & colsLastRow & ")"
Next cols
ws.Range("H" & biggestRow).Value = "TOTAL"
Application.ScreenUpdating = True
Application.Calculation = CurCal
End Sub
Related
This question already has answers here:
PowerQuery: How can I concatenate grouped values?
(3 answers)
Closed 4 years ago.
I am very new to excel macros and i need your help to fix one of my condition based concatenation problem.
i will explain the problem with simple scenario in below:
In my sheet , Column A contains customer name and Column B contains country names. Attached excel screenprint for reference ( column C and Column D will be my expected results)
In the column A, single customer name can be repeated as he can have multiple country representations
In the column B, countries placed as shown in the screenprint.
My expected results will be look alike in the column C and D as shown in the image.
I can do the column C using INDEX and i am able to get the unique values from column A
For the column D ,i am expecting the results in such a way that all countries will be concatenated and separated by ' / ' based on the corresponding customer in column A. I tried some vlookups and indexes, but i am unable
to do it.
it would be really helpful if you could provide any suggestions(function/Macros) how it will be achieved.
I am a lower intermediate vba user, so I will admit that I am sure someone can do this better than , however, this works. Add a button and then click on it, or add this to the worksheet and it will occur whenever you choose for it to be fired:
Option Explicit
Sub listout()
'declare your variables
Dim wbk As Workbook
Dim ws1 As Worksheet
Dim cprange As Range
Dim rmrange As Range
Dim bottomRow As Long
Dim row As Range
Dim countname As Variant
Dim copyname As Variant
Dim nametoRow As Long
'speed up process
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
'set what the variables are
Set wbk = ThisWorkbook
Set ws1 = wbk.Worksheets("Names List")
bottomRow = ws1.Range("A1").End(xlDown).row
'get ird of any excisting values
ws1.Range("C1:D100").ClearContents
'Set the range of the names that you want to copy, and put them into column C
Set cprange = ws1.Range(Range("A1"), Range("A1" & bottomRow))
ws1.Range(Range("C1"), Range("C1" & bottomRow)) = cprange.Value
'then remove all the duplicates
Set rmrange = ws1.Range(Range("C1"), Range("C1" & bottomRow))
rmrange.RemoveDuplicates Columns:=1, Header:=xlNo
'redclare the range as it will be shorter because you got rid of load sof duplicates
Set rmrange = ws1.Range(Range("C1"), Range("C1").End(xlDown))
'loop though each name in the 'unique' list and loop through their names in the original data then add the country to their new location in column D
For Each copyname In rmrange
For Each row In cprange
nametoRow = ws1.Application.WorksheetFunction.Match(copyname, rmrange, False)
countname = row.Offset(0, 1)
If row.Value = copyname Then
If Trim(ws1.Range("D" & nametoRow) & vbNullString) = vbNullString Then
ws1.Range("D" & nametoRow) = countname
Else
ws1.Range("D" & nametoRow) = ws1.Range("D" & nametoRow) & "/ " & countname
End If
End If
Next row
Next copyname
'turn these back on otherwise it messes with your computer/excel
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub
Here is a more efficient method.
Advanced Filter to remove duplicates from Col A, paste on Col C
Set necessary ranges
Loop through each unique name
Build String
Paste String
Loop 4 - 6 until complete
Assumptions/Actions: You have headers on Col A, B, C, & D. If you have duplicate countries for a person, the country will show up twice on the string.You will need to change "Sheet1" to your sheet name on the 3rd line.
Usually you would need to check if your value is found using the .Find method, but the below logic does not allow for a cell to not be found as it is looping through values determined by filter. It wouldn't make since for a filtered object to not be found in the range it came from.
Option Explicit
Sub CountryList()
Dim ws As Worksheet: Set ws = ThisWorkbook.Sheets("Sheet1")
Dim FoundCell As Range, SearchRange As Range, Names As Range, SearchCell As Range
Dim MyString As String, i As Long
Set SearchRange = ws.Range("A2:A" & ws.Range("A" & ws.Rows.Count).End(xlUp).Row)
SearchRange.AdvancedFilter Action:=xlFilterCopy, CopyToRange:=ws.Range("C2"), Unique:=True
ws.Range("C2").Delete Shift:=xlShiftUp
Set Names = ws.Range("C2:C" & ws.Range("C" & ws.Rows.Count).End(xlUp).Row)
For Each SearchCell In Names
Set FoundCell = SearchRange.Find(SearchCell)
For i = 1 To Application.WorksheetFunction.CountIf(SearchRange, SearchCell)
MyString = MyString & FoundCell.Offset(, 1) & "/"
Set FoundCell = SearchRange.FindNext(FoundCell)
Next i
SearchCell.Offset(, 1) = Left(MyString, Len(MyString) - 1)
MyString = ""
Next SearchCell
End Sub
I am trying to write something that does the following in excel macro (VBA):
For 'column X' of 'spreadsheet'
Copy range(row(1):row(5)
Paste to 'other spreadsheet' in range (row(1):row(5)) and column(Y)
And I want that to loop through the first spreadsheet for every column in the spreadsheet. This is what I have for 1 column:
Sheets("Info").Range("B3:B6").Value = Worksheets("Temp").Range("HK5:HK8").Value
Sheets("Info").Range("C3:C6").Value = Worksheets("Temp").Range("HK10:HK13").Value
This is what I want to do, however for every column within the first spreadsheet (there is 300 columns, manually would be tedious).
EDIT: This is another way i have found that may help explain the comments left below:
For i = 2 To 3
Worksheets("Info").Range(Cells(3, i), Cells(6, i)).Value = Worksheets("Temp").Range(Cells(5, i), Cells(8, i)).Value
Next i
I hoping this loops over the columns (2 - 290) currently its only from column 2 to 3 for testing purposes. I want the cells from TEMP worksheet from every column ('i') from row 5-8 and I want to put that into the INFO worksheet in column ('i') rows 3-6. Hope this helps!
Your description isn't consistent and I am not sure what is wrong with your final code. I have left a commented out debug statement so you can see what ranges are being worked with.
But
Use Option Explicit at the top of your code
Make sure to declare i as Long
Switch of ScreenUpdating to speed up performance
Use variables to hold the worksheets
Fully qualify Cells references with their worksheet
Public Sub test()
Dim i As Long
Dim wsInfo As Worksheet
Dim wsTemp As Worksheet
Set wsInfo = ThisWorkbook.Worksheets("Info")
Set wsTemp = ThisWorkbook.Worksheets("Temp")
Application.ScreenUpdating = False
For i = 2 To 290
' Debug.Print wsInfo.Name & "!" & wsInfo.Range(wsInfo.Cells(3, i), wsInfo.Cells(6, i)).Address & " = " & wsTemp.Name & "!" & wsTemp.Range(wsTemp.Cells(5, i), wsTemp.Cells(8, i)).Address
wsInfo.Range(wsInfo.Cells(3, i), wsInfo.Cells(6, i)).Value = wsTemp.Range(wsTemp.Cells(5, i), wsTemp.Cells(8, i)).Value
Next i
Application.ScreenUpdating = True
End Sub
I have a large dataset that is ordered in a weird way, as in the picture:
This is how my data looks currently
This is what i want it to be like
So mainly I want to do 2 things, first i want to cut the two other columns that display data, and paste them underneath the first column, but only for the first weeks period, and then sort the data, macro recording doesn't work very well since weeks are really months, therefore the amount of days changes per month, hence the height of each column.
My idea is to use a while loop to scroll through the first column (the first one displaying "Day", for each non-number entry (say the first no-greater than zero input), and then cut the whole three block array and paste it somewhere else, say a new sheet called Week "n", given it's the n'th week.
Then properly order this array, copying the two right blocks underneath the first one, and sort them by day and hour.
This I want to do for each data period of a week, but I'm not that well versed on vba's syntax to achieve this, mostly i do not know how to order the array the way im looking to once they are copied to new sheets, neither do i know how to do it if i were not to add new sheets and instead reformat it in place.
Any help is welcome.
Considering your data is set up as per the following image...
Place the following code on a Standard Module like Module1...
Sub TransformWeekData()
Dim sws As Worksheet, dws As Worksheet
Dim lr As Long, dlr As Long, i As Long
Dim Rng As Range
Application.ScreenUpdating = False
Set sws = Sheets("Sheet1") 'Source data sheet
lr = sws.Cells(Rows.Count, 1).End(xlUp).Row
On Error Resume Next
Set dws = Sheets("Combined Data") 'Output Sheet
dws.Cells.Clear
On Error GoTo 0
If dws Is Nothing Then
Set dws = Sheets.Add(after:=sws)
dws.Name = "Combined Data"
End If
On Error Resume Next
For Each Rng In sws.Range("A2:A" & lr).SpecialCells(xlCellTypeConstants, 1).Areas
If dws.Range("A1").Value = "" Then
dlr = 1
Else
dlr = dws.Range("A" & Rows.Count).End(3)(2).Row
End If
dws.Range("A" & dlr).Value = Rng.Cells(1).Offset(-2, 0).Value
dws.Range("A" & dlr + 1 & ":C" & dlr + 1).Value = Array("Day", "Amount", "Hour")
For i = 1 To 9 Step 3
dlr = dws.Range("A" & Rows.Count).End(3)(2).Row
Rng.Offset(, i - 1).Resize(Rng.Cells.Count, 3).Copy dws.Range("A" & dlr)
Next i
Next Rng
dlr = dws.Range("A" & Rows.Count).End(xlUp).Row
For Each Rng In dws.Range("A2:A" & dlr).SpecialCells(xlCellTypeConstants, 1).Areas
Rng.Resize(Rng.Cells.Count, 3).Sort key1:=Rng.Cells(1), order1:=xlAscending, key2:=Rng.Cells(1, 3), order2:=xlAscending, Header:=xlNo
Next Rng
Application.ScreenUpdating = True
End Sub
The code above will insert a sheet called Combined Data if doesn't exist in the workbook with the data in the desired format as shown in the image below...
You may change the output sheet's name as per your requirement.
I got help last week getting my syntax and ranges correct, and thought I could just do a vlookup to finish it but apparently I was mistaken. It just seems like when I try to research how to accomplish this, I find various examples but I don't have the background to translate it to my code.
The macro runs and does almost everything its supposed to do. But in addition to inserting the arrays, there are 3 other cells that need values when there are blank cells in my ‘sourcerng’.
This is the logic for the cells that need values (the values are already in my worksheet, I just need to get them to these blank cells). I tried to do an IIF statement for these but I still have no idea what I'm doing. Would that be the best way? Should it just be another IF THEN statement?
rngBE - IF Column Z = 0 Then copy value from corresponding row in column O. Otherwise copy value from column Z
rngBG - IF Column AA = "Unknown" Then copy value from corresponding row in column I. Otherwise copy value from column AA.
rngBK - IF Column AB = "Unknown" Then copy value from corresponding row in column N. Otherwise copy value from column AB.
Sub AutomateAllTheThings6()
Dim arr3() As String
Dim arr11() As String
'Dim resBE As String
Dim rng3 As Range
Dim rng11 As Range
Dim rngBE As Range
Dim rngBG As Range
Dim rngBK As Range
Dim sourcerng As Range
'Dim firstRow As Long
Dim lastRow As Long
'Dim i As Long
Call OptimizeCode_Begin
'firstRow = 2
lastRow = ActiveSheet.Range("D1").End(xlDown).Row
Set rng3 = ActiveSheet.Range("BH2:BJ" & lastRow)
Set rng11 = ActiveSheet.Range("BL2:BV" & lastRow)
Set rngBE = ActiveSheet.Range("BE2:BE" & lastRow)
Set rngBG = ActiveSheet.Range("BG2:BG" & lastRow)
Set rngBK = ActiveSheet.Range("BK2:BK" & lastRow)
Set sourcerng = ActiveSheet.Range("BE2:BE" & lastRow)
arr3() = Split("UNKNOWN,UNKNOWN,UNKNOWN", ",")
arr11() = Split("UNKNOWN,UNKNOWN,UNKNOWN,UNKNOWN,UNKNOWN,UNKNOWN,00/00/0000, _
00/00/0000,00/00/0000,00/00/0000,NEEDS REVIEW", ",")
For Each cell In sourcerng
If IsEmpty(cell) Then
Intersect(rng3, ActiveSheet.Rows(cell.Row)).Value = arr3
Intersect(rng11, ActiveSheet.Rows(cell.Row)).Value = arr11
'***PLS HELP***
Intersect(rngBE, ActiveSheet.Rows(cell.Row)).Value = "WEEEEE"
Intersect(rngBG, ActiveSheet.Rows(cell.Row)).Value = "WOOOOO"
Intersect(rngBK, ActiveSheet.Rows(cell.Row)).Value = "WAAAAA"
End If
Next
Range("BR2:BU2").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.NumberFormat = "mm/dd/yyyy"
Columns("BF:BF").Select
Selection.Delete Shift:=xlToLeft
Call OptimizeCode_End
End Sub
'*********TESTING***********
'resBE = IIf(Cells(13,Z).Value = 0, Cells(13,BE).Value = Cells(13,Z), Cells(13,BE).Value = Cells(13,O))
'***************************************
'For i = firstRow To lastRow
' valZ = Range("Z" & i)
' valOh = Range("O" & i)
'
' If valZ = 0 Then
' rngBE.Value = valOh
' Else rngBE.Value = valZ
' End If
There are several ways to do your task. If you're more of an "Excel" person than VBA you might consider this approach: You can inject the syntax of any "regular" formula in R1C1 Format.
So the formula mentioned above =if($Z2=0,$O2,$Z2) is .FORMULA format for any value in row 2.
But in .FORMULAR1C1 it can be inserted in ANY cell as: =IF(RC26=0,RC15,RC26) (basically no rows up or down, but always columns O (15) and Z(26).
So, your modified code would have something like this:
Intersect(rngBE, ActiveSheet.Rows(cell.Row)).FormulaR1C1 = "=IF(RC26=0,RC15,RC26)"
Intersect(rngBE, ActiveSheet.Rows(cell.Row)).Value = _
Intersect(rngBE, ActiveSheet.Rows(cell.Row)).Value
Again, this is NOT the most efficient way to accomplish your task, but if you're dealing with thousandsof rows, versus tens to hundreds of thousands, I wouldn't worry about it and it gives you a new tool to use.
I have a small macro which takes data from multiple xml files and pastes in xlsm. Each xml file has a tag name, and the column the data pastes into has the tag name in row 4. I'm trying to paste into one below the last used row, but the three methods I have below keep returning "1" for the last used row.
Asterisks is the code I'm having trouble with.
For Z = 1 To 16
If Cells(4, Z).Value Like i Then
Dim Lengthend As Double
Dim An As Variant
An = (Split(Cells(4, Z).Address(True, False), "$")(0))
Lengthend = *****
Cells(Lengthend + 1, Z).Select
Cells(Lengthend + 1, Z).PasteSpecial Paste:=xlPasteValues
End If
Next
Here are the three methods I used to find the end of the column:
Dim sht As Worksheet
Set sht = Sheets("PI Data")
sht.Cells(sht.Rows.Count, "An").End(xlUp).Row
And
Lengthend = Range("An" & Rows.Count).End(xlUp).Row
And
(ActiveSheet.UsedRange.Columns(An).Count)
Each of these methods returns the answer "1." Any advice on what I'm doing wrong?
Lengthend = Range("An" & Rows.Count).End(xlUp).Row
The above has a typo and works if you change it to - what you propably tried to do is pass the value of variable An and not value "An"
Lengthend = Range(An & Rows.Count).End(xlUp).Row
You should also define the worksheet you are referring to to avoid any further problems -
Lengthend = Sheets("PI Data").Range(An & Rows.Count).End(xlUp).Row