I have a workbook with about 25 worksheets.
And I want a macro to hide any rows (from 5 to 33) if there is nothing (number or text) in the column A of that row.
Can someone help please?
I have seen similar ones deleting blank rows ect. But I am not smart enough to change those to fit.
If you could give me the code I can copy it on to my file (VBA).
Please help... Thanks
Sub Hiderow()
Application.ScreenUpdating = False
Dim s As String
For i = 1 To Range("A5:A33").Count
s = i & ":" & i
If IsEmpty(Cells(i, 1).Value) Then Rows(s).EntireRow.Hidden = True
Next
Application.ScreenUpdating = True
End Sub
Loop each sheet then loop rows 5 to 33 in each worksheet.
Sub Hiderow()
Application.ScreenUpdating = False
Dim ws As Worksheet
'Loop each worksheet
For Each ws In ThisWorkbook.Worksheets
'make sure the ranges refer to the correct sheet
With ws
'Loop the rows
For i = 5 To 33
'Set hidden status based on whether there is a visible value in column A
.Rows(i).Hidden = .Cells(i, 1) = ""
Next
End With
Next ws
Application.ScreenUpdating = True
End Sub
Related
My goal is to automatically copy a range of columns (A:C) from 40+ Excel Sheet into one Sheet located in the same workbook.
The structure of all sheets is identical. Columns consist of numeric values. I want the columns to be added to the right at each iteration (so the target sheet will be enriched horizontally with the data)
My attempt (see the code below) is not automated as if I have to specify Sheet Names and Target Cell where it is possible to copy the columns
Sub macro()
Sheets("Top").Select
Columns("A:C").Select
Selection.Copy
Sheets("Low").Select
Range("D1").Select
ActiveSheet.Paste
End Sub
Any help is appreciated! Thank you
Please, try the next code. It will iterate between all existing sheets and copy all rows of columns "D:K" from all sheets in one named "Destination" (starting from "A1"). If you need it to start from "D1" it would be easy to adapt the code:
Sub copyAllSheetsInOne()
Dim ws As Worksheet, sh As Worksheet, lastRow As Long, lastEmptyCol As Long, i As Long
Set sh = Worksheets("Destination") 'a sheet named "Destination" must exist in the workbook to be processed
sh.cells.ClearContents 'clear its content (for cases when code run before)
'some optimization to make the code faster:
Application.DisplayAlerts = False: Application.EnableEvents = False
Application.Calculation = xlCalculationManual
'iterate between all existing sheets:
For Each ws In ActiveWorkbook.Worksheets
If ws.name <> "Destination" Then
lastEmptyCol = sh.cells(1, sh.Columns.count).End(xlToLeft).Column + 1
lastRow = ws.Range("D" & ws.rows.count).End(xlUp).row
If lastEmptyCol = 2 Then lastEmptyCol = 1 'for the first sheet
ws.Range("D1", ws.Range("K" & lastRow)).Copy sh.cells(1, lastEmptyCol)
End If
Next ws
Application.DisplayAlerts = True: Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
End Sub
I am taking a shot at VBA for the first time so hoping someone can help. I have a large model with lots of sheets which are from a template sample worksheet and with value set to the serial number of the sheet on each one and the name of the worksheet set to on the master sheet list.
The master sheet list has three columns
Sheet Number--Sheet Name--Delete Flag
1-- Baby_24-- Yes
2-- Baby_36-- No
3-- Baby_48-- No
4-- Baby_60-- Yes
Trying to write a macro that goes through the master sheet list (Columns A through C), filters for Delete Flag "Yes", deletes all the sheets in the filtered dataset.
After it does that then it should go through the same list and recreate the sheets again by copying the sheet and renaming to in the master list and updating cell value B$2$ on that sheet to the sheet number in the master list. This is what I have so far.
The code generates a debug error and deletes only the first filtered sheet market "Yes" in the set and never goes to the next sheet.
Sub DeleteSheets()
' Delete Sheets Marked as Yes on SkuGroup Worksheet
Dim rRange As Range, filRange As Range, Rng As Range
' Turn off Alerts
Application.DisplayAlerts = False
'Remove any filters
ActiveSheet.AutoFilterMode = False
'~~> Set your range
Set rRange = Sheets("SKU_Groups").Range("A1:C999")
With rRange
'~~> Set your criteria and filter
.AutoFilter Field:=3, Criteria1:="=Yes"
'~~> Filter, offset(to exclude headers)
Set filRange = .Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow
Debug.Print filRange.Address
For Each Rng In filRange
'~~> Your Code
ActiveCell.Value2 = Range("B" & .Offset(1, 0).SpecialCells(xlCellTypeVisible)(1).Row).Value2
Sheets(ActiveCell.Value2).Delete
Next
End With
'Remove any filters
ActiveSheet.AutoFilterMode = False
' Turn on Alerts
Application.DisplayAlerts = True
End Sub
No need to filter . try this :
Sub DeleteSelectedSheets()
Dim masterSheetName
Dim sh As Worksheet
masterSheetName = "master"
Sheets(masterSheetName).Select
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Dim rowNum
rowNum = 1
Do Until Cells(rowNum, "B").Value = ""
If Cells(rowNum, "C").Value = "Yes" Then
For Each sh In Worksheets
If sh.Name = Cells(rowNum, "B").Value Then
sh.Delete
Rows(rowNum).Delete Shift:=xlUp
rowNum = rowNum - 1
Exit For
End If
Next
End If
rowNum = rowNum + 1
Loop
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
I use the following code to combine multiple worksheets. The problem is, that this code works with worksheets that have title in the first row and my worksheets do not have. It is possible to select only 3 columns (A, F and G).. I mean the range from the woorksheets? The worksheets have the same structure only the number of lines may be different. Any idea? Thanks!
Sub Combine()
Dim J As Integer
On Error Resume Next
Sheets(1).Select
Worksheets.Add ' add a sheet in first place
Sheets(1).Name = "Combined"
' copy headings
Sheets(2).Activate
Range("A1").EntireRow.Select
Selection.Copy Destination:=Sheets(1).Range("A1")
' work through sheets
For J = 2 To Sheets.Count ' from sheet 2 to last sheet
Sheets(J).Activate ' make the sheet active
Range("A1").Select
Selection.CurrentRegion.Select ' select all cells in this sheets
' select all lines except title
Selection.Offset(1, 0).Resize(Selection.Rows.Count - 1).Select
' copy cells selected in the new sheet on last line
Selection.Copy Destination:=Sheets(1).Range("A65536").End(xlUp)(2)
Next
End Sub
Instead of copying only A, F+G you can delete all columns you don't need from the resulting sheet.
Sub Combine()
Dim jCt As Integer
Dim ws As Worksheets
Dim myRange As Range
Dim lastRow As Long
lastRow = 1
'Delete Worksheet combine if it exists
If sheetExists("Combined") Then
Application.DisplayAlerts = False
Sheets("Combined").Delete
Application.DisplayAlerts = True
MsgBox "Worksheet ""Combined"" deleted!"
End If
Worksheets.Add ' add a sheet in first place
Sheets(1).Name = "Combined"
' work through sheets
For jCt = 2 To Sheets.Count ' from sheet 2 to last sheet
Set myRange = Sheets(jCt).Range(Sheets(jCt).Cells(1, 1), Sheets(jCt).Range("A1").SpecialCells(xlCellTypeLastCell))
Debug.Print Sheets(jCt).Name, myRange.Address
'Put the SheetName on the Sheet "Cominbed"
Sheets("Combined").Range("A1").Offset(lastRow, 0) = Sheets(jCt).Name
With Sheets("Combined").Range("A1").Offset(lastRow, 0).Font
.Bold = True
.Size = 14
End With
'copy the sheets
myRange.Copy Destination:=Sheets("Combined").Range("A1").Offset(lastRow + 2, 0)
lastRow = lastRow + myRange.Rows.Count + 3
Next
End Sub
Function sheetExists(sheetToFind As String) As Boolean
sheetExists = False
For Each Sheet In Worksheets
If sheetToFind = Sheet.Name Then
sheetExists = True
Exit Function
End If
Next Sheet
End Function
I have a macro with a loop logic that I copied off of another stackoverflow/ms support page, but it doesn't seem to work.
I am not experienced with VBA so I am having trouble figuring out why the 'loop through all worksheets' part isn't working.
Can anyone please take a look at my code and tell me how it can be fixed?
Sub HideEmptyRows()
Dim rngName As Range
Dim cell As Range
Dim ws_count As Integer
Dim i As Integer
ws_count = ActiveWorkbook.Worksheets.Count
For i = 1 To ws_count
Application.ScreenUpdating = False
For Each Current In Worksheets
' This code hides the adv and group merch rows
For Each cell In Range("eq29", "eq51")
If cell.Value = 0 Then
cell.EntireRow.Hidden = True
Else
cell.EntireRow.Hidden = False
End If
Next cell
' This code hides the consulting rows
For Each cell In Range("eq61", "eq172")
If cell.Value = 0 Then
cell.EntireRow.Hidden = True
Else
cell.EntireRow.Hidden = False
End If
Next cell
Next
Application.ScreenUpdating = True
Next i
End Sub
As per my comment:
You have not assigned any of the range objects to a parent sheet so it only works on the active sheet. Just because you are looping does not automatically assign the sheet to those ranges. You will need to put Current. in front of ALL Range Objects.
The outer loop was not necessary.
I redid the logic on the hide to save some typing:
Sub HideEmptyRows()
Dim rngName As Range
Dim cell As Range
Dim current As Worksheet
Application.ScreenUpdating = False
For Each current In Worksheets
' This code hides the adv and group merch rows
For Each cell In current.Range("EQ29:EQ51")
cell.EntireRow.Hidden = cell.Value = 0
Next cell
' This code hides the consulting rows
For Each cell In current.Range("EQ61:EQ172")
cell.EntireRow.Hidden = cell.Value = 0
Next cell
Next
Application.ScreenUpdating = True
End Sub
I have a macro that hides rows based on cell values. I am attempting to use this across multiple sheets in the workbook, but not all of them. My code below seems to run the macro multiple times in the same sheet.
Sub HideRowsWbk()
Dim LastRow As Long
Dim Rng As Range
Dim ws As Worksheet
Application.ScreenUpdating = False
With ThisWorkbook
For Each ws In .Worksheets
Select Case ws.Name
Case "0000_Index", "000_BidItems", "000_EntrySheet", "000_PayReqs"
'do nothing - exclude these sheets
Case Else
With ws
LastRow = Range("A65536").End(xlUp).Row '
Set Rng = Range("M15:M" & LastRow) 'choose column where value exists
For Each cell In Rng
If cell.Value = "0" Or cell.Value = "-" Then 'checks if cell value is 0 or -
cell.EntireRow.Hidden = True
End If
Next cell
End With
End Select
Next ws
End With
Application.ScreenUpdating = True
End Sub
Please tell me what I have done wrong and how I can fix this. Also please show me how I can improve my minimal coding skills. I am using Excel 2007.
Thank you.
use:
LastRow = .Range("A65536").End(xlUp).Row '
Set Rng = .Range("M15:M" & LastRow) 'choose column where value exists
the "." makes it work with ws