The macro appears to loops through all of the worksheets fine now. However, is there a way that I can make it so the macro does not get applied to a specific worksheet in my workbook, but does get applied to all other worksheets?
Sub FormatSheet()
Dim ws As Worksheet
For Each ws In ActiveWorkbook.Worksheets
ws.Activate
Columns("A:J").Select
Selection.AutoFilter
Columns("A:J").EntireColumn.AutoFit
With Selection
.HorizontalAlignment = xlCenter
End With
With ActiveWindow
.SplitColumn = 0
.SplitRow = 1
End With
ActiveWindow.FreezePanes = True
Next ws
End Sub
I created a dataset to test this out and found that the code worked just fine. So it must be something related to your specific data/worksheets. I would see if 2 sheets works, or try making a smaller sample on another workbook and see if it works. Sorry I'm not more helpful.
Consider this approach.
Option Explicit
Sub test()
Dim ws As Worksheet
For Each ws In ThisWorkbook.Worksheets
If ws.Name <> "Sheet1" Then
With ws.UsedRange
.Resize(.Rows.Count-1).Offset(1, 0).ClearContents
End With
End If
Next ws
End Sub
Related
I have a macro that I need to loop through specific worksheets, but I built the code through many examples I found online. So I am not quite sure where or how to set the loop and I'm also certain I would have to change the way the whole code is set up. I really have no coding knowledge at all. Meep.
Sub datatransfer()
Application.ScreenUpdating = False
Dim copySheet As Worksheet
Dim pasteSheet As Worksheet
Set copySheet = Worksheets(ActiveSheet.Name)
Set pasteSheet = Worksheets("CMICIMPORT")
copySheet.Range("A100:AA124").Copy
pasteSheet.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
Application.CutCopyMode = False
Application.ScreenUpdating = True
MsgBox "Data was copied over to the CMICIMPORT tab successfully", vbInformation, ActiveSheet.Name
Range("M4").Select
With Selection.Font
.Color = -11489280
.TintAndShade = 0
End With
End Sub
I have to run the code above on each sheet that I am currently on as opposed to being able to run the Macro and it runs on all of my payroll tabs. Also my tabs are named payroll (1), payroll (2) and so forth through payroll (200) if this makes it easier to help me.
This is a quick and dirty solution, but still would work.
Start with declaring the sheets which should be looped in an Array() called specificWorksheets. If they are indeed 200, then it is a better idea to create some kind of a loop or to read them from a settings worksheets. Anyway, this is the working part:
Sub TestMe()
Dim specificWorksheets As Variant
specificWorksheets = Array("payroll (3)", "payroll (1)", "payroll (2)")
Dim wks As Worksheet
For Each wks In ThisWorkbook.Worksheets
If valueInArray(wks.Name, specificWorksheets) Then
wks.Activate
'Do your stuff, writing before...
End If
Next
End Sub
Public Function valueInArray(myValue As Variant, myArray As Variant) As Boolean
Dim cnt As Long
For cnt = LBound(myArray) To UBound(myArray)
If LCase(CStr(myValue)) = LCase(CStr(myArray(cnt))) Then
valueInArray = True
Exit Function
End If
Next cnt
End Function
At the place of the comment 'Do your stuff , copy and paste your code.
Why is this Quick and dirty? Mainly because of the using Activate and thus referring to the active worksheet. Once you realize how the for-each loop works, it is a better idea to read this - How to avoid using Select in Excel VBA - and to rewrite your code. There is a reason, why this is the second most popular topic in [vba] in StackOverflow.
Sub DataTransfer()
Dim sht As Worksheet
Application.ScreenUpdating = False
For each sht in ThisWorkbook.Worksheets
If Left(sht.Name, 7) = "payroll" Then DoIt sht
Next
Application.ScreenUpdating = True
End Sub
Sub DoIt(copySheet As Worksheet)
copySheet.Range("A100:AA124").Copy
Worksheets("CMICIMPORT").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
Application.CutCopyMode = False
MsgBox "Data was copied over to the CMICIMPORT tab successfully", vbInformation, copySheet.Name
With copySheet.Range("M4").Font
.Color = -11489280
.TintAndShade = 0
End With
End Sub
I have a macro that generates a lot of worksheets and charts. There's also various subroutines that run so the names and quantity of each worksheet/chart generated is never the same. What is constant is my HOME worksheet which is the UI for the user and I want it to be unaffected.
I found a similar question here about deleting all worksheets except the one you are working with (i.e. HOME). Here's what I have so far.
Sub ZRESET()
Dim ws As Worksheet, wb As Workbook
Set wb = ActiveWorkbook
Sheets("HOME").Select
Application.DisplayAlerts = False
For Each ws In wb.Worksheets
If ws.Name <> "HOME" Then
ws.Delete
End If
If Chart.Name = "" Then
Charts.Delete
End If
Next
Application.DisplayAlerts = True
Range("B5:E5,B9:E9,B13:E13,B14:E14").ClearContents
Range("A1").Select
End Sub
The worksheets delete fine, the hang up I have is the charts. I tried various attempts to remove charts and sometimes they work (i.e placing Charts.Delete outside of a FOR loop and IF statement). But this requires me to actually have a chart in the workbook. Sometime the user can just develop worksheets but no charts.
Any advice to continue my goal of deleting SHEETS and/or CHARTS, while keeping my HOME sheet intact?
Option Explicit
Sub GetRid()
Dim ASheet As Worksheet
Dim AChart As Chart
Application.DisplayAlerts = False
Application.ScreenUpdating = False
'** first scan for and delete all non HOME worksheets ***
For Each ASheet In ActiveWorkbook.Worksheets
If UCase(ASheet.Name) <> "HOME" Then
ASheet.Delete
End If
Next
'** Now scan and delete any ChartSheets ****
For Each AChart In ActiveWorkbook.Charts
AChart.Delete
Next
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
Option Explicit
Sub AllSheetsAndcharts()
Dim AChart As ChartObject
Dim ASheet As Worksheet
Application.DisplayAlerts = False
For Each ASheet In ActiveWorkbook.Worksheets
If UCase(ASheet.Name) <> "HOME" Then
For Each AChart In ASheet.ChartObjects
AChart.Delete
Next
ASheet.Delete
End If
Next
Application.DisplayAlerts = False
End Sub
I want to repeat this code on all the worksheets in a workbook.
There may sometimes be 1-2 worksheets sometimes 50+.
Sub HoursTotal()
'
' HoursTotal Macro
'
Range("F2").Select
ActiveCell.FormulaR1C1 = "=SUM(C[-1])"
Range("F1").Select
ActiveCell.FormulaR1C1 = "Total Hours"
Range("G1").Select
End Sub
This should do it.
Sub HoursTotal()
Dim ws As Worksheet
For Each ws In Worksheets
ws.Range("F2").FormulaR1C1 = "=SUM(C[-1])"
ws.Range("F1").FormulaR1C1 = "Total Hours"
ws.Range("G1").Select 'I don't think you need this line but I included it anyways
Next
End Sub
Simple modification of your current code should do it:
Sub HoursTotal()
'
' HoursTotal Macro
'
Dim ws as Worksheet
For Each ws in Worksheets
ws.Range("F2").Select
ActiveCell.FormulaR1C1 = "=SUM(C[-1])"
ws.Range("F1").Select
ActiveCell.FormulaR1C1 = "Total Hours"
ws.Range("G1").Select
Next ws
End Sub
But here's what it looks like without the Select's
Sub HoursTotal()
'
' HoursTotal Macro
'
Dim ws as Worksheet
For Each ws in Worksheets
ws.Range("F2").FormulaR1C1 = "=SUM(C[-1])"
ws.Range("F1").FormulaR1C1 = "Total Hours"
ws.Range("G1").Select
Next ws
End Sub
You need to activate the worksheet so that excel can make changes to it.
`Sub HoursTotal()
Dim ws As Worksheet
For Each ws In Worksheets
ws.Activate
ws.Range("F2").FormulaR1C1 = "=SUM(C[-1])"
ws.Range("F1").FormulaR1C1 = "Total Hours"
ws.Range("G1").Select 'I don't think you need this line but I included it anyways
Next
End Sub`
I encountered the following code:
Sub HideSheets()
Dim Sht As Worksheet
For Each Sht In ActiveWorkbook.Worksheets
If Sht.Name <> ActiveSheet.Name Then
Sht.Visible = xlSheetHidden
End If
Next Sht
End Sub
What it does is to use a loop to hide all worksheets in the active workbook, except the active sheet. What is xlSheetHidden and why is it not defined?
Its an enumeration. Normally something like this would be True or False, but here we have three possibilities, including xlSheetVeryHidden
I am needing to copy cells B3:W400 from multiple sheets (will have varying names each time it is run) and paste values into "CombinedPlans", appending each new selection under the last. I need 3 sheets excluded from the code: IBExport, MonthlyIBs, and Combined Plans.
A lot of googling with trial and error has given me the following code, which I got to work in my "practice" workbook. Now that I have put it into my production workbook, it is no longer copying any sheets. It just skips straight to the message box. What am I doing wrong?
Sub consolidatetest()
Sheets("CombinedPlans").Select
Range("B3:W1048576").Select
Selection.ClearContents
Dim J As Integer
Dim sh As Worksheet
Const excludeSheets As String = "QBExport,MonthlyIBs,CombinedPlans"
On Error Resume Next
For Each sh In ActiveWorkbook.Worksheets
If IsError(Application.Match(sh.Name, Split(excludeSheets, ","))) Then
Application.GoTo Sheets(sh.Name).[b3]
Range("B3:W400").Select
Selection.Copy
Worksheets("CombinedPlans").Activate
Range("B1048576").End(xlUp).Offset(rowOffset:=1, columnOffset:=0).PasteSpecial xlPasteValues
End If
Next
Application.CutCopyMode = False
MsgBox "Complete!"
End Sub
This should work. If you have still problems, make sure that the Sheet CombinedPlans is indeed so named.
Sub consolidatetest()
Dim wb As Workbook
Dim sh_CombPlans As Worksheet
Set wb = ThisWorkbook
Set sh_CombPlans = wb.Sheets("CombinedPlans")
sh_CombPlans.Range("B3:W1048576").ClearContents
Dim sh As Worksheet
For Each sh In ActiveWorkbook.Worksheets
Select Case sh.Name
Case "QBExport", "MonthlyIBs", "CombinedPlans":
'Do Nothing
Case Else
sh.Range("B3:W400").Copy
sh_CombPlans.Range("B1048576").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
End Select
Next
Application.CutCopyMode = False
MsgBox "Complete!"
End Sub