I have a worksheet (named RsOut) with 235 columns. I need to overwrite the values in only certain columns with data from another sheet(named rsTrans). Both sheets have a unique identifier that I am using to match.
I decided to use the Sumif function to populate the rsOut worksheet. Where I ran into a snag is I cannot figure out how to run the script for all rows in the column that have data.
Once we figure this out, I need to repeat this process for roughly 15 other columns.
My over-arching question is even after we get the sumif to work properly, what is the most efficient way to execute the code so that it repeats 15 more times?
The Criteria list and the CriteriaRange will always have the same location. But the Sum Range and the column where the results are inserted will change for each of the 15 columns.
So, Thoughts on the most efficient way to proceed...maybe separate the sumif code as it's own block and call upon it instead of repeating the steps over and over, and/or list out all the sum ranges and all the insert ranges, so the script just loops through them..Would love your insight VBA masters.
Issue:
I think my main issue is that I tried to use a rngList as the criteria.
I also tried to separate the sumif as a separate block of code, to call on. I may have screwed something up there as well.
The error highlights on the Set sumRange row. (Runtime error 1004 - Method 'Range' of Object '_Worksheet' Failed.
Any help you can provide would be greatly appreciated!!
Sub SumifmovewsTransdatatowsOut()
Dim wb As Workbook, wsOut As Worksheet
Dim wsTrans As Worksheet, rngList As Range
Dim sumRange As Range
Dim criteriaRange As Range
Dim criteria As Long 'Setting as long because the IDs (criteria) are at least 20 characters. Should this be a range??
Set wb = ThisWorkbook
Set wsTrans = Worksheets("DEL SOURCE_Translator") 'Worksheet that contains analysis and results that need to be inserted into wsOut
Set wsOut = Worksheets("FID GDMR - Output_2") 'Worksheet where you are pasting results from wsTrans
Set rngList = wsOut.Range("B2:B" & wsOut.Cells(Rows.Count, "B").End(xlUp).Row) 'this range of IDs will be different every run, thus adding in the count to find last row...or do I not need the rnglist at all? Just run the sumif for all criteria B2:b
Set sumRange = wsTrans.Range("ag21:ag") 'Values in wsTrans that need to be added to wsOut
Set criteriaRange = wsTrans.Range("AA21:AA") 'Range of IDs found on wsTrans
criteria = rngList
Sumif
End Sub
'Standard Sumif formula
Sub Sumif()
wsOut.Range("AT2:AT") = WorksheetFunction.SumIfs(sumRange, criteriaRange, criteria)
End Sub
'OR should the Sumif formula be: rng.Formula = "=SUMIF(criteriaRange,rngList,sumRange)"
SUBSEQUENT TESTING after receiving recommendations:
I tested using the second recommendation only because a future user could easily change out the array values if the columns shifted on the wsout template. Below is the code that I used and the resulting error.
Result issues:
the result in each changed cell is #NAME?
a pop up box shows up for each request. It is looking for the translater. See screenshot below. If I x out of each pop up box, the script completes and each cell has the #NAME?
enter image description here
Thoughts on what went wrong?
Code:
Sub test2()
Dim wsTrans As Worksheet: Dim wsOut As Worksheet
Dim rgCrit As String: Dim rgSum As String
Dim rgR As Range: Dim i As Integer: Dim arr
arr = Array("AG:AT", "AJ:BB", "AM:BJ", "AT:BR", "AZ:CA", "BP:DE", "BW:DO") 'change as needed
Set wsTrans = Sheets("DEL SOURCE_Translator") 'change as needed
Set wsOut = Sheets("FID GDMR - Output_2") 'change as needed
rgCrit = wsTrans.Name & "!" & wsTrans.Columns(27).Address 'Column 27 is AA in wsTrans which contains the criteria range
Set rgR = wsOut.Range("B2", wsOut.Range("B2").End(xlDown)) 'change as needed
startCell = "$" & Replace(rgR(1, 1).Address, "$", "")
For i = LBound(arr) To UBound(arr)
rgSum = wsTrans.Name & "!" & Split(arr(i), ":")(0) & ":" & Split(arr(i), ":")(0)
With rgR.Offset(0, Range(Split(arr(i), ":")(1) & 1).Column - rgR.Column)
.Value = "=SUMIF(" & rgCrit & "," & startCell & "," & rgSum & ")"
.Value = .Value
End With
Next
End Sub
'Sum Ranges in wsTrans: AG, AJ, AM, AT, AZ, BP, BW
'Result Columns in wsOut: AT, BB, BJ, BR, CA, DE, DO
Additional Review:
Also, to test, instead of x'ing out of the pop up, I selected my file in the pop up. when I did, a second pop up below showed up. Interestingly, the sheet name is missing the DEL on the front. When I select the correct sheet, I still get the #Name? error.
enter image description here
Okay, so your question is a little too broad for this website. The general rule is each question should address one specific issue.
That being said, I think I can help you with a few easy to solve points.
1) Making Sumif Work:
Using Sumif() function inside a Sub is the same as using it in an Excel formula. First you need two full ranges, next you need a value to lookup.
Full ranges: wsTrans.Range("ag21:ag") is not going to work because it doesn't have an end row. Instead, it needs to be wsTrans.Range("AG21:AG100"). Now since you don't seem to know your last row, I would suggest you find that first and then integrate it into all your ranges. I'm using the variable lRow below.
Option Explicit
Sub TestSum2()
Dim WB As Workbook
Dim wsTrans As Worksheet
Dim wsOut As Worksheet
Dim criteriaRange As Range
Dim sumRange As Range
Dim rngList As Range
Dim aCriteria 'Array
Dim lRow As Long
Set WB = ThisWorkbook
Set wsTrans = WB.Worksheets("DEL SOURCE_Translator")
Set wsOut = WB.Worksheets("FID GDMR - Output_2")
lRow = wsOut.Range("B" & Rows.Count).End(xlUp).Row
Set rngList = wsOut.Range("B2:B" & lRow)
aCriteria = rngList 'Transfer Range to array
lRow = wsTrans.Range("AA" & Rows.Count).End(xlUp).Row
Set sumRange = wsTrans.Range("AG21:AG" & lRow)
Set criteriaRange = wsTrans.Range("AA21:AA" & lRow)
Debug.Print Application.WorksheetFunction.SumIf(criteriaRange, aCriteria(1, 1), sumRange)
End Sub
The above sub returns:
Which is correct considering the following sheets:
2) Making it loop through the criteria list
You've already made a great start on looping through this criteria list by importing rngList into an array. Next we just need to loop that array like so:
Option Explicit
Sub TestSum2()
Dim WB As Workbook
Dim wsTrans As Worksheet
Dim wsOut As Worksheet
Dim criteriaRange As Range
Dim sumRange As Range
Dim rngList As Range
Dim aCriteria 'Array
Dim lRow As Long
Dim I As Long
Set WB = ThisWorkbook
Set wsTrans = WB.Worksheets("DEL SOURCE_Translator")
Set wsOut = WB.Worksheets("FID GDMR - Output_2")
lRow = wsOut.Range("B" & Rows.Count).End(xlUp).Row
Set rngList = wsOut.Range("B2:B" & lRow)
aCriteria = rngList 'Transfer Range to array
lRow = wsTrans.Range("AA" & Rows.Count).End(xlUp).Row
Set sumRange = wsTrans.Range("AG21:AG" & lRow)
Set criteriaRange = wsTrans.Range("AA21:AA" & lRow)
For I = 1 To UBound(aCriteria, 1)
Debug.Print "Sum of " & aCriteria(I, 1) & "=" & _
Application.WorksheetFunction. _
SumIf(criteriaRange, aCriteria(I, 1), sumRange)
Next I
End Sub
This results in an output of:
Then to finish it off, you'll need to check which column to put it in, maybe with a .Find or maybe with a Match() of the column headers, but I don't know what your data looks like. But, if you just want to output that range to your output sheet here's how to do that:
Sub TestSum2()
Dim WB As Workbook
Dim wsTrans As Worksheet
Dim wsOut As Worksheet
Dim criteriaRange As Range
Dim sumRange As Range
Dim rngList As Range
Dim aCriteria 'Array
Dim OutputSums
Dim lRow As Long
Dim I As Long
Set WB = ThisWorkbook
Set wsTrans = WB.Worksheets("DEL SOURCE_Translator")
Set wsOut = WB.Worksheets("FID GDMR - Output_2")
lRow = wsOut.Range("B" & Rows.Count).End(xlUp).Row
Set rngList = wsOut.Range("B2:B" & lRow)
aCriteria = rngList 'Transfer Range to array
lRow = wsTrans.Range("AA" & Rows.Count).End(xlUp).Row
Set sumRange = wsTrans.Range("AG21:AG" & lRow)
Set criteriaRange = wsTrans.Range("AA21:AA" & lRow)
ReDim OutputSums(1 To UBound(aCriteria, 1), 1 To 1)
For I = 1 To UBound(aCriteria, 1)
OutputSums(I, 1) = Application.WorksheetFunction. _
SumIf(criteriaRange, aCriteria(I, 1), sumRange)
Next I
wsOut.Range("C2").Resize(UBound(OutputSums, 1), 1) = OutputSums
End Sub
Resulting in:
If I understand you correctly, besides Mr. Cameron's answers, another way maybe you can have the VBA using formula.
Before running the sub is something like this :
After running the sub (expected result) is something like this:
Please ignore the fill color, the sorting and the value, as they are used is just to be easier to calculate manually for the expected result.
The Criteria list and the CriteriaRange will always have the same
location. But the Sum Range and the column where the results are
inserted will change for each of the 15 columns.
Since you don't mention where are the columns for the Sum Range will be, this code assume that it will be in a consecutive column to the right of column ID, as seen in the image of sheet1 ---> rgSUM1, rgSUM2, rgSUM3.
And because you also don't mention in what column in sheet2 the result is, this code assume that it will be in a consecutive column to the right of column ID, as seen in the image of sheet2 ---> SUM1, SUM2, SUM3.
If your Sum Range columns are random and/or your Sum Result columns are random, then you can't use this code. For example : your rgSum1 is in column D sheet1 - rgSum1Result sheet2 column Z, rgSum2 is in column AZ sheet1 - rgSum2Result sheet2 column F, rgSum3 is in column Q sheet1 - rgSum3Result sheet2 column DK, and so on until 15 columns. I think it will need an array of column letter for both rgSum and rgSumResult if they are random.
Sub test()
Dim sh1 As Worksheet: Dim sh2 As Worksheet
Dim rgCrit As String: Dim rgSum As String
Dim rgR As Range: Dim col As Integer
col = 3 'change as needed
Set sh1 = Sheets("Sheet1") 'change as needed
Set sh2 = Sheets("Sheet2") 'change as needed
rgCrit = sh1.Name & "!" & sh1.Columns(1).Address 'change as needed
rgSum = sh1.Name & "!" & Replace(sh1.Columns(2).Address, "$", "") 'change as needed
Set rgR = sh2.Range("A2", sh2.Range("A2").End(xlDown)) 'change as needed
startCell = "$" & Replace(rgR(1, 1).Address, "$", "")
With rgR.Resize(rgR.Rows.Count, col).Offset(0, 1)
.Value = "=SUMIF(" & rgCrit & "," & startCell & "," & rgSum & ")"
.Value = .Value
End With
End Sub
Basically the code just fill the range of the expected result with SUMIF formula.
col = how many columns are there as the sum range
sh1 (wsTrans in your case) is the sheet where the ID and the multiple sum range are.
sh2 (wsOut in your case) is the sheet where the ID to sum and the multiple sum result are.
rgCrit is the sh1 name with the column of the range of criteria (column A, (ID) in this case)
rgSum is the sh1 name with the first column of Sum Range (column B in this case)
rgR is the range of the unique ID in sheet2 (column A in this case, must have no blank cell in between, because it use xldown) and finally, startCell is the first cell address of rgR
Below if the SumRange and ResultRange are random column.
Sub test2()
Dim sh1 As Worksheet: Dim sh2 As Worksheet
Dim rgCrit As String: Dim rgSum As String
Dim rgR As Range: Dim i As Integer: Dim arr
arr = Array("B:G", "F:E", "D:B") 'change as needed
Set sh1 = Sheets("Sheet13") 'change as needed
Set sh2 = Sheets("Sheet14") 'change as needed
rgCrit = sh1.Name & "!" & sh1.Columns(1).Address 'change as needed
Set rgR = sh2.Range("A2", sh2.Range("A2").End(xlDown)) 'change as needed
startCell = "$" & Replace(rgR(1, 1).Address, "$", "")
For i = LBound(arr) To UBound(arr)
rgSum = sh1.Name & "!" & Split(arr(i), ":")(0) & ":" & Split(arr(i), ":")(0)
With rgR.Offset(0, Range(Split(arr(i), ":")(1) & 1).Column - rgR.Column)
.Value = "=SUMIF(" & rgCrit & "," & startCell & "," & rgSum & ")"
.Value = .Value
End With
Next
End Sub
The arr value is in pair : sum range column - sum result column.
Example arr in code :
First loop : sum range column is B (sheet1) where the result will be in column G (sheet2).
Second loop: sum range column is F (sheet1) where the result will be in column E (sheet2).
Third loop: sum range column is D (sheet1) where the result will be in column B (sheet2).
screenshot of code
I am trying to calculate sum in cell "I13" of sheet2 with inputs based on the dynamic range.
Formula
range("I13").formula= "=sum('sheet1'!A1:A3)"
works but the range can be dynamic. For this I have used lr to identify the last row in the range
lr=cells(rows.count,1).end(xlup).row
Now, I want to modify the above formula such that in place of A3, it takes last cell. i.e. A&lr
Have tried using range("I13").formula= "=sum('sheet1'!A1:A"&lr)", but it results in error
Sub MMM()
Windows("Template.xlsx").activate
sheets("sheet1").select
range("a1").select
lr=cells(rows.count,1).end(xlup).row
sheets("sheet2").select
'this code works. But want dynamic range
'range("I13").formula = "= SUM('sheet1'!A1:A3)"
range("I13").formula = "= sum('sheet1'!A1:A&lr)"
End Sub
you can try to define the variable:
Option Explicit ' It should be used when you define variable
Sub MMM()
Dim lr as Range ' Define variable
Windows("Template.xlsx").activate
sheets("sheet1").select
range("a1").select
lr=cells(rows.count,1).end(xlup).row
sheets("sheet2").select
range("I13").formula = "= sum('sheet1'!A1:A&lr)"
End Sub
You have to join the string for the formula like this:
"=SUM('Sheet1'!A1:A" & lastRow & ")"
Alternatively:
If you set the whole range to be summed then you can use the Address of this range. The External-parameter returns the sheet name as well.
Sub MMM()
Dim wb As Workbook: Set wb = ThisWorkbook
Dim wsSource As Worksheet: Set wsSource = wb.Worksheets("Sheet1")
Dim wsTarget As Worksheet: Set wsTarget = wb.Worksheets("Sheet2")
Dim rgDataToSum As Range
With wsSource
Set rgDataToSum = .Range("A1", .Cells(.Rows.Count, 1).End(xlUp))
End With
wsTarget.Range("I13").Formula = "=SUM(" & rgDataToSum.Address(True, True, External:=True) & ")"
End Sub
I am trying to write a vlookup code that uses the lookups tab as the array (A:B) and the revenue tab where the vlookup is in cell Y2. I need it to fill all the way through column Y.
Sub VLOOKUP()
Dim LookupsLastRow As Long
Dim RevenueLastRow As Long
Dim LookupsSheet As Worksheet
Dim RevenueSheet As Worksheet
'What are the names of our worksheets?
Set LookupsSheet = Worksheets("Lookups")
Set RevenueSheet = Worksheets("Revenue")
'Determine last row of source
With LookupsSheet
LookupsLastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
End With
With RevenueSheet
'Determine last row in col P
RevenueLastRow = .Cells(.Rows.Count, "X").End(xlUp).Row
'Apply our formula
.Range("Y2:Y" & RevenueLastRow).Formula = _
"=VLOOKUP(V2,"Lookups"!$A$2:$B$" & LookupsLastRow & ",2,0)"
End With
End Sub
Hi I'm looking to create code for copying certain columns (AH to AX) across all worksheets then skipping worksheets named "Aggregated" & "Collated Results"
I have this already
Sub FillSheets()
Dim ws As Worksheets
Dim worksheetsToSkip As Variant
Dim rng As Range
Dim sh As Sheet1
Set rng = sh.Range("AH1:AX7200")
worksheetsToSkip = Array("Aggregated", "Collated Results")
For Each ws In Worksheets
If IsError(Application.Match(ws.Name, worksheetsToSkip, 0)) Then
End Sub
This will
Loop through sheets
"Copy" data from AH1 - AX1 down to the last used row that is determined by Column AH (Update column if needed)
"Paste" data on a sheet named Sheet1 (Update if needed). The data will be pasted in Column AH on the first available blank row. It's not clear what column you want to paste the data in. You just need to change AH to Some Column to modify
"Copy" and "Paste" are in quotes because we are really just transferring values here since this is quicker. We are actually setting the values of two equal sized ranges equal to each other.
Option Explicit
Sub AH_AX()
'Update "Sheet1" to sheet where data is being pasted
Dim ms As Worksheet: Set ms = ThisWorkbook.Sheets("Sheet1")
Dim ws As Worksheet, wsLR As Long, msLR As Long
Dim CopyRange As Range, PasteRange As Range
For Each ws In Worksheets
If ws.Name <> "Aggregated" And ws.Name <> "Collated Results" Then
'Determine last rows
wsLR = ws.Range("AH" & ws.Rows.Count).End(xlUp).Row
msLR = ms.Range("AH" & ms.Rows.Count).End(xlUp).Offset(1).Row
'Set Ranges
Set CopyRange = ws.Range("AH1:AX" & LR)
Set PasteRange = ms.Range("AH" & msLR).Resize(CopyRange.Rows.Count, CopyRange.Columns.Count)
'Value Transfer (Quicker than copy/paste)
PasteRange.Value = CopyRange.Value
End If
Next ws
End Sub
In excel vba I'm tryin to select a range of values starting in Cell"O2", (O from Oyster) down to the end of the sheet,
I'm trying:
Range("O2", Range.End(xlDown))
But that fails with Argument Not Optional. What am i doing wrong?
I'm using Excel 2010.
Don't use xlDown Declare your Objects and then work with it.
Use this
Option Explicit
Sub Sample()
Dim ws As Worksheet
Dim LRow As Long
Dim rng As Range
'~~> Change this to the relevant sheet name
Set ws = ThisWorkbook.Sheets("Sheet1")
With ws
'~~> Find last row in Col O which has data
LRow = .Range("O" & .Rows.Count).End(xlUp).Row
'~~> This is your range
Set rng = .Range("O2:O" & LRow)
With rng
'~~> Whatever you want to do
End With
End With
End Sub
To select the range from O2 to the last filled cell in that column, you could use:
Range("O2", Range("O2").End(xlDown)).Select
But that has a few problems, including the fact that it will "stop" at any blanks, and that you should avoid using Select unless absolutely necessary. Also, you should get in the habit of qualifying your ranges, e.g., specifying which worksheet they're in. Given all that, I propose something like this, assuming you wanted to turn the cells in the range red:
Sub test()
Dim LastRow As Long
Dim ws As Excel.Worksheet
Set ws = ActiveSheet
With ws
LastRow = .Range("O" & .Rows.Count).End(xlUp).Row
.Range("O2:O" & LastRow).Interior.Color = vbRed
End With
End Sub
Maybe you need
Range("O2", Range("O2").End(xlDown)).Select
?