I have a workbook with multiple worksheets and the worksheets are layed out exactly the same. For example C5 could be cycle time, and I want to know the average cycle time over all the sheets. The only issue is that I have a lot of data, I have data from row 5 through 125004, and columns A through J. I am unsure of how to average the data onto one sheet at the end that still has the 125004 rows and columns A through J, just displaying the average from all the worksheets.
A 3D formula would appear to be adequate, such as:
=AVERAGE(Sheet1:Sheet3!C5)
copied around to suit.
Create a module in VBA and write the following
Public Function GetAllSheetsAverage(makeUpdate As Boolean) As Double
If makeUpdate Then
Application.Volatile
End If
Dim rng As Range
Dim sht As Worksheet
Set rng = Application.Caller
Dim sum As Double
sum = 0
Dim count As Integer
count = 0
For Each sht In ThisWorkbook.Worksheets
If sht.Name = rng.Worksheet.Name Then GoTo SkipOwnSheet
Dim rng2 As Range
Set rng2 = sht.Range(rng.Address)
sum = sum + rng2.Value
count = count + 1
SkipOwnSheet:
Next sht
GetAllSheetsAverage = sum / count
End Function
The use the function =GetAllSheetsAverage(TRUE()) on the cells.
The TRUE will make the function listen to every change in the worksheets, so it'll probably be slow on such a huge amount of data.
You can change to false, but the you'll have to update the values manually whenever there is a change on the values from the other sheets.
Related
I'm trying to fill blank cells in a certain region with 0. The reagion should be defined in the current workbook but in sheet2 (not the current sheet). Also the place where it is supposed to fill is between columns
BU:CQ in the current region (not all 100 000 000 lines). Just the number of lines that define the table between columns BU and CQ. I know the problem lies in defining the region... See the code below.
What is missing?
Sub FillEmptyBlankCellWithValue()
Dim cell As Range
Dim InputValue As String
On Error Resume Next
InputValue = "0"
For Each cell In ThisWorkbook.Sheets("Sheet2").Range(BU).CurrentRegion
'.Cells(Rows.Count, 2).End(xlUp).Row
If IsEmpty(cell) Then
cell.Value = InputValue
End If
Next
End Sub
I've this code that i'm positive that works! But i don't wnat selection! I want somthing that specifies the sheet and a fixed range.
Now my idea is to replace "selection" with the desired range. - In this case in particular the range should be 1 - between BU:CQ; 2 - starting at row 2; 3 - working the way down until last row (not empty = end of the table that goes from column A to DE)
Sub FillEmptyBlankCellWithValue()
Dim cell As Range
Dim InputValue As String
On Error Resume Next
For Each cell In Selection
If IsEmpty(cell) Then
cell.Value = "0"
End If
Next
End Sub'
PS: And I also need to specify the sheet, since the button that will execute the code will be in the same workbook but not in the same sheet.
Use SpecialsCells:
On Error Resume Next 'for the case the range would be all filled
With ws
Intersect(.UsedRange, .Range("BU:CQ")).SpecialCells(xlCellTypeBlanks).Value = 0
End With
On Error GoTo 0
MUCH faster than looping !
Try using cells() references, such as:
For i = cells(1,"BU").Column to cells(1,"CQ").Column
cells(1,i).value = "Moo"
Next i
In your current code you list Range(BU) which is not appropriate syntax. Note that Range() can be used for named ranges, e.g., Range("TheseCells"), but the actual cell references are written as Range("A1"), etc. For Cell(), you would use Cells(row,col).
Edit1
With if statement, with second loop:
Dim i as long, j as long, lr as long
lr = cells(rows.count,1).end(xlup).row
For i = 2 to lr 'assumes headers in row 1
For j = cells(1,"BU").Column to cells(1,"CQ").Column
If cells(i,j).value = "" then cells(i,j).value = "Moo"
Next j
Next i
First off, you should reference the worksheet you're working with using:
Set ws = Excel.Application.ThisWorkbook.Worksheets(MyWorksheetName)
Otherwise VBA is going to choose the worksheet for you, and it may or may not be the worksheet you want to work with.
And then use it to specify ranges on specific worksheets such as ws.Range or ws.Cells. This is a much better method for specifying which worksheet you're working on.
Now for your question:
I would reference the range using the following syntax:
Dim MyRange As Range
Set MyRange = ws.Range("BU:CQ")
I would iterate through the range like so:
Edit: I tested this and it works. Obviously you will want to change the range and worksheet reference; I assume you're competent enough to do this yourself. I didn't make a variable for my worksheet because another way to reference a worksheet is to use the worksheet's (Name) property in the property window, which you can set to whatever you want; this is a free, global variable.
Where I defined testWS in the properties window:
Public Sub test()
Dim MyRange As Range
Dim tblHeight As Long
Dim tblLength As Long
Dim offsetLen As Long
Dim i As Long
Dim j As Long
With testWS
'set this this to your "BU:CQ" range
Set MyRange = .Range("P:W")
'set this to "A:BU" to get the offset from A to BU
offsetLen = .Range("A:P").Columns.Count - 1
'set this to your "A" range
tblHeight = .Range("P" & .Rows.Count).End(xlUp).Row
tblLength = MyRange.Columns.Count
End With
'iterate through the number of rows
For i = 1 To tblHeight
'iterate through the number of columns
For j = 1 To tblLength
If IsEmpty(testWS.Cells(i, offsetLen + j).Value) Then
testWS.Cells(i, offsetLen + j).Value = 0
End If
Next
Next
End Sub
Before:
After (I stopped it early, so it didn't go through all the rows in the file):
If there's a better way to do this, then let me know.
so recently I have been looking into using defined ranges to copy data instead of selecting, copying and pasting cells. This way I hope to optimise the performance and the runtime of my code.
Unfortunately I have come to face a problem I wasn't able to solve on my own.
When defining a range I want to rearrange the columns in a different order.
For example:
Set my_range = Sheets("Sheet1").Range("A2:E2,G2:H2,J2:K2,M2")
Works well, as the columns I fill into the range are behind each other in the sheet. But now I have this:
Set yo_range = Sheets("Sheet2").Range("D2,AV2,L2,H2,Q2,AE2,AG2")
If I fill these ranges into a new sheet the yo_range will fill the columns I put into it but not in the order I written down. It will put it down in the order according to the original one. In this example yo_range would put the data in this order into the new sheet:
D2 | H2 | L2 | Q2 | AE2 | AG2 | AV2
How can I fix this? I want the order to be another one than the original one.
Also - as you can see my_range has more columns than yo_range. How can I let yo_range be filled into the new sheet but at certain points leave columns out? For example:
my_range(A2:E2) goes into A2:E2 in the new sheet
yo_range(D2,AV2) goes into A:B in the new sheet, then leave C out and then paste yo_range(L2,H2) into D:E in the new sheet
I hope that I was able to explain my problem well and that there is somebody able and willing to help me. Any help is appreciated.
Edit:
Here's the code that puts the values from the ranges into the new sheet
Do
If Application.WorksheetFunction.CountA(my_range) > 0 Then
my_range.Copy ws.Range("A" & ws.Rows.Count).End(xlUp).Offset(1, 0)
Set my_range = my_range.Offset(1, 0)
Else
Exit Do
End If
Loop
Do
If Application.WorksheetFunction.CountA(yo_range) > 0 Then
yo_range.Copy ws.Range("A" & ws.Rows.Count).End(xlUp).Offset(1, 0)
Set yo_range = yo_range.Offset(1, 0)
Else
Exit Do
End If
Loop
We can see that the Copy method will re-arrange the data left-to-right. Try this:
Option Explicit
Public Sub CheckClipboard()
Dim ws As Worksheet
Dim rngToCopy As Range
Dim objData As Object
Dim varContents As Variant
' test data b,c,d,e,f,g in Sheet1!B1:G1
Set ws = ThisWorkbook.Worksheets("Sheet1")
ws.Range("B1:G1").Value = Array("b", "c", "d", "e", "f", "g")
Set rngToCopy = ws.Range("E1:F1,G1,B1:C1") '<-- note not left-to-right order
rngToCopy.Copy '<-- copy
' this is a late bound MSForms.DataObject
Set objData = CreateObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
' copy current cell formula to clipboard
objData.GetFromClipboard
varContents = objData.GetText
Debug.Print varContents '<-- re-arranged left-to-right
' cancel copy
Application.CutCopyMode = False
End Sub
I get this in the immediate window:
b c d e f g
So, using Copy is not going to work for what you want to do.
In order to 'paste' the data in the order that you set it in the Range, you need to iterate each Area of the Range and then each cell (i.e. Range) in each Area. See the test code below which replicates your issue and presents a solution:
Option Explicit
Sub MixColumns()
Dim ws As Worksheet
Dim rngIn As Range
Dim rngOut As Range
Dim lng As Long
Dim rngArea As Range
Dim rngCell As Range
Set ws = ThisWorkbook.Worksheets("Sheet1")
' example 1
Set rngIn = ws.Range("B1:C1,E1:F1,G1") '<-- 5 cells, non-contiguous, forward order
Set rngOut = ws.Range("B2:F2") '<-- 5 contiguous cells
rngIn.Copy rngOut '<-- works
' example 2 - OP problem
Set rngIn = ws.Range("E1:F1,G1,B1:C1") '<-- 5 cells, non-contiguous, odd order
Set rngOut = ws.Range("B3:F3") '<-- 5 contiguous cells
rngIn.Copy rngOut '<-- should be e,f,g,b,c but gets b,c,e,f,g
' example 3 - solution for OP problem
Set rngIn = ws.Range("E1:F1,G1,B1:C1") '<-- 5 cells, non-contiguous, odd order
Set rngOut = ws.Range("B4:F4") '<-- 5 contiguous cells
lng = 1 '<-- rngOut cell counter
' iterate areas
For Each rngArea In rngIn.Areas
' iterate cells in area
For Each rngCell In rngArea.Cells
rngOut.Cells(1, lng).Value = rngCell.Value '<-- copy single value
lng = lng + 1 '<-- increment rngOut counter
Next rngCell
Next rngArea '<-- results in e,f,g,b,c
End Sub
Give this output:
I have a weekly report that I am running. I have two separate worksheets. In the first worksheet I input my data (a table with 2 columns and unknown number of rows beforehand) and I want to create a macro where I click it and I cut all these data, and move them to the other worksheet. In the worksheet where the table is pasted, I want the data to be pasted as values ( include the initial formulas) and be pasted below the data from the previous week.
e.g. If I cut data from Worksheet1 from cells A1:B7, I want to paste the values in Worksheet2, in cells A7:B14. Next week, the data should be cut-pasted from cells A1:B5 in Worksheet1 to cells A15:B20 in Worksheet2
I have this code so far but I am doing something wrong. I am at a beginner level with vba.
Sub Movetabletototal()
Dim Count As Integer
Dim Table As Range
Dim CountRange As Range
Worksheets("TOTAL").Select
Set CountRange = Range("A2:A1000")
Count = Application.WorksheetFunction.Count(CountRange)
Worksheets("MIXER TOTAL").Select
Set Table = Range("P3:Q12")
Worksheets("TOTAL").Select
Worksheets("TOTAL").Range("A1").Select
ActiveCell.Offset(1, Count + 1).Select
ActiveCell.Value = Table
Worksheets("MIXER TOTAL").Select
Worksheets("MIXER TOTAL").Range("P3:Q12").Clear Contents
If Worksheets("TOTAL").Range("A2").Offset(1, Count) <> "" Then
Worksheets("TOTAL").Range("A2").End(xlDown).Select
End If
End Sub
Thank you!
This code successfully does this:
e.g. If I cut data from Worksheet1 from cells A1:B7, I want to paste
the values in Worksheet2, in cells A7:B14. Next week, the data should
be cut-pasted from cells A1:B5 in Worksheet1 to cells A15:B20 in
Worksheet2
Edit per your comment:
Using P3:Q12 on "MIXER TOTAL" as your data that changes, and pasting to columns A:B on the "TOTAL" sheet after current data.
Sub Movetabletototal()
Dim Count As Integer
Dim copyRng As Range, pasteRng As Range
Dim totalWS As Worksheet, mixerWS As Worksheet
Set totalWS = Worksheets("TOTAL")
Set mixerWS = Worksheets("MIXER TOTAL")
Set copyRng = mixerWS.Range("P3:Q" & mixerWS.Cells(mixerWS.Rows.Count, 17).End(xlUp).Row)
Dim newRow As Long
newRow = totalWS.Cells(totalWS.Rows.Count, 1).End(xlUp).Row
If newRow > 1 Then newRow = newRow + 1
copyRng.Copy totalWS.Range(totalWS.Cells(newRow, 1), totalWS.Cells(newRow + copyRng.Rows.Count, copyRng.Columns.Count))
copyRng.ClearContents
End Sub
Change those ranges as necessary. (Note, currently if your data goes from P3:Q1000, it'll copy all that range. If you strictly want P3:Q12, then change CopyRng to just mixerWS.Range("P3:Q12")
I'm new to programming and need help.
I have an excel sheet that will have 8760 rows (for every hour in a year), in order to distinguish between each new day, I need to insert an empty row every 24 lines. I know I have to use a for loop but not sure what VBA syntax to use and so on.
This is what I have so far, I just don't know where to put the "every 24 lines condition":
For i = 1 to i = 8760
Worksheets("Sheet1").Cells(i, "A").Select
ActiveCell.EntireRow.Insert
Next
Thanks in advance
Just loop over the range of cells and use VBA's mod operator to check to see if you should be inserting a row. You may also want to read Modulo operator on wikipedia.
Public Sub InsertRowOnceEvery24Rows()
Dim ws As Worksheet
Set ws = ThisWorkbook.ActiveSheet 'adjust this to get the sheet you need
Dim rng As Range
Set rng = ws.Range("A1:A50") 'adjust this to whatever range of cells you need
Dim i As Integer
i = 1
Dim cell As Range
For Each cell In rng
If i Mod 24 = 0 Then
cell.EntireRow.Insert xlShiftDown
End If
i = i + 1
Next
End Sub
I want to find all the cells in Column L with a particular value and return the values in Column D of the same row as those cells found.
So far, I am only able to return one result, which would be the top most result in my list, but I want to find all the rest as well, which I don't know the code to use.
Just to further explain: Value in cell D11 is the value I want to find in Column L of sheet "Master List". Supposedly I find the value in cells L13, L15 and L20, I want to return the value in cell D13, D15 and D20 into cells "C37:C39" of ws. Note: no. of cells that have the value may vary so the values returned will just appear from C37 downwards (something like automatic multiple selection, copy and paste)
Here's a little something to start the ball rolling:
Sub FindRelatedProducts()
Dim cell As Excel.Range
Dim D11Value As Variant
Dim D11Row As Variant
Dim ws As Worksheet: Set ws = Sheets("RShip")
Set cell = ws.Range("D11")
D11Value = cell.Value
With Sheets("Master List")
D11Row = Application.Match(D11Value, .Range("L:L"), 0)
If Not IsError(D11Row) Then
ws.Range("C37") = .Range("D" & D11Row).Value
End If
End With
End Sub
Here's an example using range variables.
You'll want to define a range for the input data range and a range for the output data. Then in the VBA you will want to change the wrk, inRng and outRng variables to be the named ranges you defined and change the column indexes in the for and if blocks to match the column index of the data you are looking for.
Option Explicit
Option Base 1
Sub FindValues()
Dim wrk As Worksheet
Dim inRng As Range
Dim outRng As Range
Dim cntr As Long
Dim outCntr As Long
Dim findVal As Double
Set wrk = Worksheets("Data")
Set inRng = wrk.Range("LookupRange")
Set outRng = wrk.Range("OutputRange")
' Clear the output range in case you have fewer values on this run than on the previous one
outRng.ClearContents
' Set the value you are looking for
findVal = 1
' Iterate through the rows in the input range. If you find the result you want then write it to the output range
For cntr = 1 To inRng.Rows.Count
If inRng(cntr, 1) = findVal Then ' Assumes the value you are finding is in column 1 of the input range
outRng(outCntr, 1) = inRng(cntr, 2) ' Assumes the values you are exporting is in column 2 of the input range
outCntr = outCntr + 1
End If
Next cntr
End Sub