I am very new to programming so this may be an obvious question. I have a questionnaire asking about drinking habits. I am trying to make an application that will work out the mean etc across all worksheets (participant responses). My code so far allows me to get the total number of worksheets as a number of participant responses but it will only give me the mean for the worksheet that is currently open.What would I need to add to the below code to allow me to get the total mean across all the responses (worksheets).
Code:
Function PARTcounter() 'to count the open questionaires
Dim WS_Count As Integer
Dim I As Integer
WS_Count = ActiveWorkbook.Worksheets.Count
For I = 1 To WS_Count
TBTOTpar = WS_Count
Next I
End Function
Function SUMwk11() 'finds mean for week 1
Dim ws As Worksheet
Dim rng As Range
Dim WS_Count As Integer
Dim A As Double
Dim B As Double
WS_Count = ActiveWorkbook.Worksheets.Count
For counter = 0 To WS_Count
Next
A = Application.SUM(Range("c3:i9"))
B = A / 7
TBwk1MEAN = B
End Function
Your for loops don't actually do anything.... You could also do this all in one sub (Not sure why you're using functions). This should do what you want once you've updated the TBwk1MEAN to change each loop
Sub PARTcounter() 'to count the open questionaires
TBTOTpar = ThisWorkbook.Worksheets.Count
End Sub
Sub SUMwk11() 'finds mean for week 1
Dim ws As Worksheet
For each ws in ThisWorkbook.Worksheets
' You'll need to update this each loop otherwise the mean from each sheet will overwrite the previous one.
TBwk1MEAN = Application.SUM(ws.Range("c3:i9")) / 7
Next ws
End Sub
Related
I posted a question for a macro solution to applying a filter across multiple worksheets based on header match.
Link: Loop Through Multiple Worksheets and Apply Filter
I require help with a partial header match and not just an exact match, because, some of the headers will not be an exact match for the criteria - i.e, some will have "STATUS" as the header, some will be "prefix_Status", others "CurrentStatus" and so on.. So I need to use the Instr function (Unless there's some better option) to find any header that contains the word STATUS but I cannot seem to figure out where or how to use it..
I have the current solution which throws the following error on the Match line:
Type Mismatch
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
Dim count As Integer, rngData As Range
With Worksheets(I)
Set rngData = .Range("A1").CurrentRegion
count = Application.Match("*STATUS*", Worksheets(I).Range("A1:AZ1"), 0)
If Not IsError(count) Then
rngData.autofilter Field:=count, Criteria1:="INACTIVE"
End If
End With
Next I
End Sub
Application.Match returns an error when no match is found. Your using IsError to check for errors but the code is stopping before that point. You need to skip the errors so that you can catch them later in code.
Try adding: On Error Resume Next
Full Code:
Sub WorksheetLoop()
Dim WS_Count As Integer, i As Integer, count As Integer
Dim rngData As Range
' Set WS_Count equal to the number of worksheets in the active
' workbook.
WS_Count = ActiveWorkbook.Worksheets.count
'If Application.Match finds no match it will throw an error so we need to skip them
On Error Resume Next
' Begin the loop.
For i = 1 To WS_Count
With Worksheets(i)
count = Application.Match("*STATUS*", Worksheets(i).Range("A1:AZ1"), 0)
If Not IsError(count) Then
Set rngData = .Range("A1").CurrentRegion
rngData.AutoFilter Field:=count, Criteria1:="INACTIVE"
End If
End With
Next i
End Sub
Tested on simple data set
Before:
After:
I'm trying to learn a bit of VBA. So I'm new to this.
I want a loop that goes from the second sheet until the last one, and then deletes the last line of a table in single one of the sheet's.
Currently I have this code that I search in the web.
Sub ApagaLoop()
'Apaga todas as linhas das tabelas, e percorre todas as folhas.
Dim WS_Count As Integer
Dim I As Integer
Dim sht As Worksheet
Dim LastRow As Long
' Set WS_Count equal to the number of worksheets in the active
' workbook.
WS_Count = 7
' Begin the loop.
For I = 2 To WS_Count
' Insert your code here.
Sheets(I).Cells(Rows.Count, 1).End(xlUp).Rows().Select
Rows(ActiveCell.Row).Select
Selection.Delete Shift:=xlUp
' 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
And I'm getting an error in:
Sheets(I).Cells(Rows.Count, 1).End(xlUp).Row
Can someone tell me what I'm doing Wrong?
Thanks a lot
Most probably your ActiveWorkbook has less then 7 worksheets
so just change
WS_Count = 7
to
WS_Count = ActiveWorkbook.Worksheets.Count
furthermore you can avoid Select/Selection and use a full Range reference, as follows:
Option Explicit
Sub ApagaLoop()
'Apaga todas as linhas das tabelas, e percorre todas as folhas.
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 = 2 To WS_Count
' deletes the last line of current worksheet
Worksheets(I).Cells(Rows.Count, 1).End(xlUp).EntireRow.Delete Shift:=xlUp
' 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
Here is another approach using For Each ws In Worksheets to reference the worksheets and .Find to reference the last row on the worksheet regardless of what column it is in.
Sub ApagaLoop()
Dim ws As Worksheet
Dim Target As Range
For Each ws In Worksheets
If ws.Index <> 1 Then
Set Target = ws.Cells.Find(What:="*", After:=ws.Range("A1"), SearchDirection:=xlPrevious)
If Not Target Is Nothing Then
If MsgBox("Do you want to delete " & Target.EntireRow.Address(External:=True), vbYesNo, "Delete Last Row") = vbYes Then
Target.EntireRow.Delete
End If
End If
End If
Next
End Sub
Yesterday I decided to learn some VBA to make my excel time easier. It has been going better then expected, but I have been breaking my teeth on this code for many hours now.
I am trying to remove all empty (except title) columns, and this in all sheets of a workbook.
After lots of googling I managed to find some examples i could adapt to my needs.
I used this code: remove columns
and then tried to loop it through the sheets by using dear old microsoft support
Together i frankensteined it into this:
Sub WorksheetLoop()
Dim WS_Count As Integer
Dim I As Integer
Dim MyRange As Range
Dim iCounter As Long
WS_Count = ActiveWorkbook.Worksheets.Count
For I = 1 To WS_Count
'removecode
' Define the target Range.
Set MyRange = ActiveWorkbook.Worksheets(I).UsedRange
'Start reverse looping through the range.
For iCounter = MyRange.Columns.Count To 1 Step -1
'If entire column is empty then delete it.
If Application.CountA(Columns(iCounter).EntireColumn) = 1 Then
Columns(iCounter).Delete
End If
Next iCounter
'endremovecode
MsgBox ActiveWorkbook.Worksheets(I).Name
Next I
End Sub
When I run this, only the the starting worksheet is cleaned up. The messagebox does loop through all of them.
Why? What am I doing wrong?
I tried finding a solution, but non of the topics here seemed to give more clarity.
Thank a bunch for leading me in the right direction.
Lara
Columns(iCounter).EntireColumn
and
Columns(iCounter).Delete
are not prefixed with MyRange so refer to the active sheet's columns not the sheet containing MyRange. Stick MyRange. infront of them.
You're almost there. You just need to qualify your application.counta and also your .columns().delete. so each is working directly with the sheet in question. Otherwise it's just working with the active sheet.
Try this:
Sub WorksheetLoop()
Dim WS_Count As Integer
Dim I As Integer
Dim MyRange As Range
Dim iCounter As Long
Dim ws As Worksheet
WS_Count = ActiveWorkbook.Worksheets.Count
For I = 1 To WS_Count
Set ws = ActiveWorkbook.Worksheets(I)
'removecode
With ws
' Define the target Range.
Set MyRange = .UsedRange
'Start reverse looping through the range.
For iCounter = MyRange.Columns.Count To 1 Step -1
'If entire column is empty then delete it.
If Application.CountA(.Columns(iCounter).EntireColumn) = 0 Then
.Columns(iCounter).Delete
End If
Next iCounter
End With
'endremovecode
MsgBox ws.Name
Next I
End Sub
I am receiving a next without for error from:
Sub CTLines()
Dim iVal As Integer
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim rng As Range
Set ws1 = Worksheets("INCIDENTS")
Set ws2 = Worksheets("INCDB")
iVal = Application.WorksheetFunction.CountIf(Range("AO5:AO999"), "Yes")
Dim i
For i = 1 To iVal
With Sheets("INCDB")
.Range("5:5").Insert Shift:=x1Down
Next i
End Sub
I've tried changing the variable, the indent, many things and I've not been successful.
All I want to do is to count how many rows contain Yes in the AO column and add as many rows in the INCDB spreadsheet.
Change the code to this, near the bottom:
For i = 1 To iVal
With Sheets("INCDB")
.Range("5:5").Insert Shift:=xlDown
End With
Next i
The VBA compiler is not good at reporting what is wrong, when it encounters code that has one or more lines that are missing a matching termination line.
In your case you never terminated the With statement.
I am trying to loop through a list of (randomly named) worksheets and for each calculate the last row and then loop though all the rows and execute some code.
I've tried the code below but I'm getting Invalid Procedure Call or Argument. I've modified in all kinds of ways but it's driving me crazy...thank you in advance.
Sub myloop()
Dim ws As Variant
Dim WsArray As Variant
Dim rcount As Integer
WsArray = Array("mysheet1", "mysheet2", "mysheet3", "mysheet4")
With ThisWorkbook
For Each ws In WsArray
rcount = .Worksheets(ws).Cells("A1").End(xlDown).Row
For i = 1 To rcount
If ...Then
End If
Next
Next
End With
End Sub
#Santosh makes a great point about finding the last row. As for the original question, in any Workbook there exists a Worksheets collection that might actually be easier to loop through depending on your structure:
Dim ws As Worksheet
For Each ws In Worksheets
'match worksheet names if necessary using ws.Name...
'
'do other cool stuff...
'
'wrap it all up
Next ws
Try this. Instead of going to cell A1 and going down to find the last row its better to go to last cell (rows.count) and then go up.
Sub myloop()
Dim ws As Variant
Dim WsArray As Variant
Dim rcount As Integer
WsArray = Array("mysheet1", "mysheet2", "mysheet3", "mysheet4")
With ThisWorkbook
For Each ws In WsArray
With .Worksheets(ws)
rcount = .Cells(.Rows.Count, "A").End(xlUp).Row
End With
For i = 1 To rcount
'If .. Then
End If
Next
Next
End With
End Sub