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
Related
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
I feel like this is too simple to be stuck on, but I have a workbook with about 100 sheets, and I need to copy a range from one sheet (Sheet2 Range a1:H200) to Sheet5 AF1:AM200 and every sheet after (Sheet5 through Sheet100 or more). I have tried creating a loop and copying the original range and pasting to each sheet, but it hasn't worked. I feel like this is the closest I've gotten
Sub CopyPasteLoop()
Dim wsVar As Worksheet
For Each wsVar In ThisWorkbook.Sheets
With wsVar
ThisWorkbook.Worksheets("Sheet2").Range("A1:H200").Value = ThisWorkbook.Worksheets("Sheet5").Range("AF1").Value
End With
Next wsVar
End Sub
I feel like it should be simpler, but I can't make it work. Thanks!
Almost there. Try this:
Sub CopyPasteLoop()
Dim wsVar As Worksheet
Dim i as Integer
For i = 5 to ThisWorkbook.Worksheets.Count
ThisWorkbook.Worksheets(i).Range("AF1:AM200").Value = ThisWorkbook.Worksheets("Sheet2").Range("A1:H200").Value
Next i
End Sub
Or for better performance, use this:
Dim vRange as Variant
vRange = ThisWorkbook.Worksheets(2).range("A1:H200")
Dim i as Integer
For i = 5 to ThisWorkbook.Worksheets.Count
ThisWorkbook.Worksheets(i).Range("AF1:AM200").Value = vRange
Next i
Hopefully #Scott Holtzman's answer will work for you (providing your sheets are indexed in the same order as they're named). This approach will also work.
Dim wb As Workbook, ws As Worksheet
Dim rng As Range
Set wb = ThisWorkbook
Set rng = wb.Sheets("Sheet2").Range("A1:H200")
For Each ws In wb.Sheets
If CInt(Right(ws.Name, Len(ws.Name) - Len("Sheet"))) >= 5 Then
ws.Range("AF1:AM200").Value = rng.Value
End If
Next ws
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 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
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