I have an Excel workbook with multiple worksheets and I would like to use SUMPRODUCT formula to sum values from all worksheets with name Page 1, Page 1(2), Page 1(3), Page 1(4) etc.:
=SUMPRODUCT(SUMIF(INDIRECT("'"&D2:D4&"'!B11:B100"),$B3,INDIRECT("'"&D2:D4&"'!E11:E100")))
The problem is that the number of Page 1 worksheets is different every time and I need to update &D2:D4& every time manually. Is there any way I could automate it so I don't need to change the range manually?
Please paste the code below in the ThisWorkbook code sheet of the workbook in which you have your SUMPRODUCT formula. Then adjust the code to comply with the comments I added into it (especially with regard to the name of the worksheet on which you have the range D2:D4.
Option Explicit
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
SetPageRange
End Sub
Private Sub SetPageRange()
' this procedure creates a named range "Pages" which you can
' use in your formula instead of "D2:D4"
' =SUMPRODUCT(SUMIF(INDIRECT("'"& Pages &"'!B11:B100"),$B3,INDIRECT("'"& Pages &"'!E11:E100")))
Const WsName As String = "Page" 'Page, Page (1), Page(x)
' change to "Page 1" if that is what you need
Dim Wb As Workbook
Dim MasterWs As Worksheet
Dim Arr() As String
Dim i As Integer
Dim Ws As Worksheet
' the Active workbook is not necessarily the workbook containing this code !!
Set Wb = ActiveWorkbook
ReDim Arr(1 To 20) ' maximum number of sheets you expect
' this number of rows must be available
' below D2 in the sheet where your
' formula resides
For Each Ws In Wb.Worksheets
' this collects all sheets whose name starts with "Page"
If InStr(1, Ws.Name, WsName, vbTextCompare) = 1 Then
i = i + 1
Arr(i) = Ws.Name
End If
Next Ws
' Change the name "Sheet5" to the name of the sheet where your
' SUMPRODUCT formula resides and where you currently have D2:D4
' if it isn't in the ActiveWorkbook, then where is it?
Set MasterWs = Wb.Worksheets("Sheet5")
With MasterWs.Cells(2, "D") ' this is where the names will be written
' from D2 down (20 rows, as set above)
.Resize(UBound(Arr)).Value = Application.Transpose(Arr)
Wb.Names.Add Name:="Pages", RefersTo:="=" & .Resize(i).Address(True, True, xlA1, True)
End With
End Sub
Save the workbook as macro-enabled (xlsm format) Now, this code will run automatically when you save the workbook. I imagined that you would open it, import a number of "Page 1" sheets and then want to make your totals. So, now you will have to save it first. The range D2:D4 (D2:D20 in my code) will be adjusted automatically.
If you don't like the automation, delete the Workbook_BeforeSave procedure entirely (or place an apostrophe at the beginning of each of its lines). You can run the SetPageRange procedure manually by placing the cursor anywhere in it and pressing F5. You can get it to be available for being run from Excel's worksheet interface by changing the attribute Private to Public.
The code will create a named range named "Pages" and you will need to change your formula to point to the named range (the size and content of which the code manipulates) instead of the present "D2:D4". The revised formula is included in the code's comments above.
Related
I have a template file, whereby multiple copies of the template (5 to 20) are completed, then consolidated into one master file. This file contains multiple sheets (18) and hundreds of entries in each sheet.
Not every cell is a number requiring consolidation, i.e there are titles and dates etc which are repeated, with no clear structure. Re-organising the template is not an option. The best way is to calculate only cells with a "Currency" type.
Here is the code I have so far. I have pieced it together from a number of searches, but will admit that I don't fully understand vba so I know I'm missing something obvious.
To make this a bit simpler, I have closed everything else and opened the target files manually before running this, then called upon the open excel files. Improving this bit of the code so that I can just put the target files into a sub folder and then use that path would be nice but not necessary.
I do not need to change the cell colour at the end, but I just did that as a quick visual reference to see whether it had ran.
The script in this format does not throw up any errors, but simply runs without actually calculating and populating the total value into each cell. I would guess that my approach of trying to extract the sheet and cell reference for every loop is wrong, but I cannot find the answer anywhere, so any help would be greatly appreciated.
totalValue = totalValue + Worksheets(sht).Cells(R, C)
is completely the wrong syntax, and the crux of the issue, but I simply don't know how to fix this within the context of the two existing For Each loops.
Sub ConsolidatedFigures()
Application.ScreenUpdating = False
'Declare variable types
Dim ws As Worksheet
Dim totalValue As Double
Dim C As Integer
Dim R As Integer
Dim wb As Workbook
Dim sht As String
Dim myRange As Range
Dim cell As Range
'Start to loop through each sheet in the workbook
For Each ws In ThisWorkbook.Worksheets
'get the current sheet name to later search for the same sheet in other workbooks
sht = ws.Name
'set the range in the current sheet
Set myRange = ws.UsedRange
'Now loop though every cell in the range
For Each cell In myRange
'Only target cells with an "currency" style so we're not trying to sum text
If cell.Style = "Currency" Then
'get the current cell references to later search for the same cell in other workbooks
C = cell.Column
R = cell.Row
'Within the current cell, go through open workbooks (except this one) to create a total of all the corresponding cells
For Each wb In Application.Workbooks
'the target workbooks will be open already, and nothing else. Disregard this open workbook and personal book
If wb.Name <> "PERSONAL.xlsb" AND wb.Name <> "consolidation.xlsm" Then
totalValue = totalValue + Worksheets(sht).Cells(R, C)
End If
Next wb
'populate the cell with the total of the corresponding cells
cell.Value = totalValue
'change cell colour to show the above step worked
cell.Interior.ColorIndex = 5
End If
'move on to next cell in worksheet
Next cell
'move on to next sheet in the workbook
Next ws
Application.ScreenUpdating = True
End Sub
I am creating a blank workbook with a command button that upon clicking, I want it to perform actions on EVERY open workbook currently open (as I will have other workbooks that aren't blank that I want it to carry out operations on).
I get a Subscript out of range error when I run:
Sub Button1_Click()
'
' Button1_Click Macro
' Fire Ext. Comments
'
'
Dim w As Workbook
' For every open workbook...
For Each w In Application.Workbooks
' Activate the current workbook
w.Activate
' Find the comments column (K12 should be the "Comments" column)
If Worksheets("FIRE EXT.").Range("K12").Value = "Comments" Then
' Then we loop through all cells in the specified range (anything below the header row)
Dim rng As Range, cell As Range
' I'm using a range of 500 to look for values, so if a file has more than 500 rows, you'll have to look at it manually
Set rng = Range("A1:A500")
' No loop to change all comments
For Each cell In rng
.......................
...at the "If Worksheets("FIRE EXT.").Range("K12").Value = "Comments" Then" line. So I'm thinking it's starting with the blank workbook and not finding the worksheet named "FIRE EXT.", so what would be the best practise to first test if the activated workbook first has that sheet name, otherwise move on to the next workbook? Thanks!
UPDATE
This was what worked for me, but the other responses would have worked too. Thanks everyone!
Sub Button1_Click()
'
' Button1_Click Macro
' Fire Ext. Comments
'
'
Dim w As Workbook
' For every open workbook...
For Each w In Application.Workbooks
' Don't work on the current/blank workbook
If w.FullName <> ThisWorkbook.FullName Then
' Find the comments column (K12 should be the "Comments" column)
If w.Sheets("FIRE EXT.").Range("K12").Value = "Comments" Then
' Then we loop through all cells in the specified range (anything below the header row)
Dim rng As Range, cell As Range
' I'm using a range of 500 to look for values, so if a file has more than 500 rows, you'll have to look at it manually
Set rng = w.Worksheets("FIRE EXT.").Range("A13:A500")
' No loop to change all comments
For Each cell In rng
You need to fully qualify all of your references. You can also put in a check to ensure it skips the blank workbook (see my comments in this updated code):
Sub Button1_Click()
'
' Button1_Click Macro
' Fire Ext. Comments
'
'
Dim w As Workbook
' For every open workbook...
For Each w In Application.Workbooks
If w.FullName <> ThisWorkbook.FullName Then '<-- TA: Add check to verify you're not working on the blank workbook
'TA: I removed the .Activate line, that is never necessary. Instead, fully qualify all your references
' Find the comments column (K12 should be the "Comments" column)
If w.Worksheets("FIRE EXT.").Range("K12").Value = "Comments" Then '<-- TA: Note that Worksheets is now qualified to w so that it is checking worksheets in the current w workbook
' Then we loop through all cells in the specified range (anything below the header row)
Dim rng As Range, cell As Range
' I'm using a range of 500 to look for values, so if a file has more than 500 rows, you'll have to look at it manually
Set rng = w.Worksheets("FIRE EXT.").Range("A1:A500") '<-- TA: Note that Range is now qualified to w.Worksheets("FIRE EXT.") (if that isn't the correct sheet name, change this to the correct sheet name)
' Now loop to change all comments
For Each cell In rng
.......................
I wanted to type a comment, but it got pretty long.
You will get an error if the Sheet Name "FIRE EXT." (with the period) does not exist on the workbook you are working with. You are looping ALL workbooks, if you have one that doesn't have that sheet, it will error out.
It's better to stick with Sheets when using the Sheet Name, and Worksheets when using the Sheet Number. Sheets("SheetName") vs Worksheets(1)
Avoid using Activate/Select by using the assigned workbook variable, in your code, that's "w"
Sub Button1_Click()
Dim w As Workbook
' For every open workbook...
For Each w In Application.Workbooks
' Find the comments column (K12 should be the "Comments" column)
If w.Sheets("FIRE EXT.").Range("K12").Value = "Comments" Then
' Then we loop through all cells in the specified range (anything below the header row)
Dim rng As Range, cell As Range
' I'm using a range of 500 to look for values, so if a file has more than 500 rows, you'll have to look at it manually
Set rng = w.Sheets("FIRE EXT.").Range("A1:A500")
' Now loop to change all comments
For Each cell In rng
' Now here you dont use "w.Sheets("FIRE EXT.")" because it is already set on `rng'
' so you can just use `cell` like cell.value = "Blah"
.........
i can do simple row deletions etc in single sheets in VBA, but this one has me stumped.
I need to search for ANY data (likely to be an email address, but in reality could be any text or number) in N1:N100, across all open worksheets...except Sheet1 (i.e. from Sheet2 to whatever the last open worksheet is)...
...if any data is found in the N1:N100 range for that particular worksheet (i.e. Sheet2) then do nothing and search the next worksheet (i.e. Sheet3)...if no data is found then enter "NONE" in cell N1 (on i.e. Sheet2) and then move onto the next worksheet (i.e. Sheet3).
Ive seen IF/ELSEIF/THEN code from other people, but it all seems to be sheet specific...and as i said im a bit out of my depth with this particular part.
This will feed into a larger bit of VBA code that ive got thats already spread over several sheets of A4, thought i had worked out all the bugs by now :D
Sub WorksheetLoop()
Dim WS_Count As Integer
Dim I As Integer
' Set WS_Count equal to the number of worksheets in the active
' workbook.
WS_Count = ActiveWorkbook.Worksheets.Count
' Begin the loop.
For I = 1 To WS_Count
' Insert your code here.
' The following line shows how to reference a sheet within
' the loop by displaying the worksheet name in a dialog box.
MsgBox ActiveWorkbook.Worksheets(I).Name
Next I
End Sub
Or you can loop over all of the worksheets using a For Each loop:
Sub WorksheetLoop2()
' Declare Current as a worksheet object variable.
Dim Current As Worksheet
' Loop through all of the worksheets in the active workbook.
For Each Current In Worksheets
' Insert your code here.
' This line displays the worksheet name in a message box.
MsgBox Current.Name
Next
End Sub
Is it possible to let Excel automatically select the first empty cell in column A, whenever I open the document?
I have got the following to find the the first empty line:
ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Value + 1.Count, 1).End(xlUp).Value + 1
In order to get Excel to select the first empty cell in column A when you open your workbook, you need to place the following code in the ThisWorkbook module.
Private Sub Workbook_Open()
Dim ws As Worksheet
Set ws = ActiveSheet
ws.Cells(ws.Rows.Count, 1).End(xlUp).Offset(1, 0).Select
End Sub
This will select the first empty cell in the ActiveSheet. If you got multiple sheets in your workbook and you want to select the first empty row in a specific sheet, say Sheet1, you should change the second line of code to:
Set ws = ActiveWorkbook.Sheets("Sheet1")
You can do that.
You need write VBA(macro) program to realize.
Code you need is as follow
Private Sub Workbook_Open()
ActiveWindow.Range("A65536").End(xlUp).Offset(1,0).Select
End Sub
Meaning of code is:
"Private Sub Workbook_Open()" is predefined name subroutine which will be executed when the workbook be opened.
"ActiveWindow.Range("A65536").End(xlUp)" will find last cell with data in A column ("last cell")
"ActiveWindow.Range("A65536").End(xlUp).Offset(1,0)" will move to cell next to "last cell", that will be first blank cell.
ActiveWindow.Range("A65536").End(xlUp).Offset(1,0).Select will select tha first blank cell.
I assumed that you use Excel 2003 or older, OR number of rows with data in your worksheet is less than 65536.
If you use Excel 2007 or newer and you have rows with data in your worksheet more than 65536, please modify 65536 to the value large enough to cover rows in your worksheet.
I'm tyring to look for a way to return a range of cells with just the lookup function. Is this really possible?
Basically like this:
=LOOKUP([MasterBook.xlsm]Sheet3!$A:$A,?)
I just want the function to look in the main workbook through all of Column A and return all cells for Column A that have something in them.
EDIT for poster below:
Sure. I have two workbooks; one workbook is essentially a local product that has a "master" sheet on top and then individual worksheets following it that have all of their information extracted from the master sheet. The second workbook is a local copy of a product that I send to a non-local entity higher up the food chain. Basically I need to pull information from the individual sheets in my first workbook and put it in the appropriate columns in the second workbook. I have a macro that gets the info from my sheets in the one workbook over to the other, but the second workbook is formatted differently. I was looking for a way to use a formula if possible.
The macro I am referring to is:
Sub CopyTest()
Dim sourceColumn As Range, targetColumn As Range
Set sourceColumn = Workbooks("Local Workbook.xlsm").Worksheets("Sheet3").Columns("A")
Set targetColumn = Workbooks("Nonlocal Workbook.xlsm").Worksheets("Sheet1").Columns("A")
sourceColumn.Copy Destination:=targetColumn
End Sub
All this does is pull the specified column from one sheet and put it in the column on the second book; but it just pastes it starting in the first block. Since the non-local book is formatted differently, the column I need to transfer to doesn't start until Row 9. shrug I have ideas abuot what I'm trying to do with this, but my ideas tend to exceed my technical ability (which occasionally makes it difficult to explain). :)
Depending on how different your workbooks are formatted. Here is two way to handle this:
Adapt your macro
Instead of copying the whole column, you can copy paste, only the values you want to.
Here is an example:
Sub CopyTest()
Dim rSource As Range, rTarget As Range
Dim lEnd As Long
lEnd = Range("A65536").End(xlUp).Row
Set rSource = Workbooks("Local Workbook.xlsm").Worksheets("Sheet3").Range("A1:A" & lEnd)
Set rTarget = Workbooks("Nonlocal Workbook.xlsm").Worksheets("Sheet1").Range("A9")
rSource.Copy Destination:=rTarget
End Sub
Use a formula
If your data are not in the same order, you'd better use a VLOOKUP formula.
See how it works.
Don't hesitate to post another question with what you've built for some help. Please give as much details as possible so we could help you the best way.
[EDIT] Another try following the comments
Option Explicit
Dim wTarget As Workbook
Sub mainCopy()
Dim bGo As Boolean
bGo = True
'Add a new workbook to copy the data - do you want the user to select one?
Set wTarget = Application.Workbooks.Add()
Do While bGo
CopyTest
bGo = MsgBox("Do you want to import data from another workbook?", vbYesNo, "Continue?")
Loop
End Sub
Sub CopyTest()
Dim rSource As Range, rTarget As Range
Dim lEnd As Long, lCol As Long
Dim ws As Worksheet
Dim vFile As Variant
vFile = Application.GetOpenFilename("Excel-files,*.xls", _
1, "Select One File To Open", , False)
'if the user didn't select a file, exit sub
If TypeName(vFile) = "Boolean" Then Exit Sub
Workbooks.Open vFile
For Each ws In ActiveWorkbook.Worksheets
'do you need to copy the columns separately?
' For lCol = 1 To 10
'find the last cell of the 10th column
lEnd = ws.Cells(65536, 10).End(xlUp).Row
Set rSource = ws.Range("A1:J" & lEnd)
'How can we define the target worksheet?
Set rTarget = wTarget.Worksheets("Sheet1").Range("A9")
rSource.Copy Destination:=rTarget
' Next lCol
Next ws
End Sub