I am currently trying to hide certain columns if Row(8:8) meets certain criteria. My For Each loop is currently not working. Could someone point me in the right direction?
Sub hide()
' hide Macro
'
Dim rng As Range
For Each rng In Range("F:BJ").Columns
If Rows.Range("8") = "Test" Or Rows.Range("8") = "Test1" Then
Column.rng.EntireColumn.Hidden = True
End If
Next rng
End Sub
You can do it this way:
Dim rng As Range
For Each rng In Range("F8:BJ8")
If rng.Value = "Test" Or rng.Value = "Test1" Then
rng.EntireColumn.Hidden = True
End If
Next rng
Presumably, you would want to unhide the columns if the value in row 8 was changed programmatically or otherwise.
Dim rng As Range
With Worksheets("Sheet1")
For Each rng In .Range("F8:BJ8")
rng.EntireColumn.Hidden = _
CBool(LCase(rng.Value) = "test" Or LCase(rng.Value) = "test1")
Next rng
End With
The Rows and Columns ranges refer to the whole spreadsheet if you don't specify a range.
Sub hideColumn()
Dim rng As Range
For Each rng In Range("F:BJ").Columns
If rng.Rows(8) = "Test" Or rng.Rows(8) = "Test1" Then
rng.EntireColumn.Hidden = True
End If
Next rng
End Sub
Related
I have code within a workbook that works exactly how I want it to, but I am looking for ways to increase its efficiency/speed. My thought would be to add a union for all blank rows and hide that range all at once. Can this be done?
Sub HideRws()
Dim Rng As Range, Cl As Range
With Sheet3
For Each Cl In .Range("A11:A60")
Cl.EntireRow.Hidden = Cl.Value = ""
Next Cl
For Each Rng In .Range("A71:A120, A131:A180, A190:A239").Areas
If Rng(1) = "" Then
Rng.Offset(-6).Resize(58).EntireRow.Hidden = True
Else
For Each Cl In Rng
Cl.EntireRow.Hidden = Cl.Value = ""
Next Cl
End If
Next Rng
End With
End Sub
I think this does the same thing:
Sub HideRows()
With Sheet3
.Range("A11:A60").SpecialCells(xlCellTypeBlanks).EntireRow.Hidden = True
For Each Rng In .Range("A71:A120, A131:A180, A190:A239").Areas
If Rng(1) = "" Then
Rng.Offset(-6).Resize(58).EntireRow.Hidden = True
Else
Rng.SpecialCells(xlCellTypeBlanks).EntireRow.Hidden = True
End If
Next Rng
End With
End Sub
I have growing data files and in a certain column is not fill out. I have the code to fill the data, though I want to make a button to call userform for user to fill in the range so that the code works within the range provided by the user(since data is adjusted by the user itself). The code to fill the blank cell is;
Sub fillblank()
Dim range As Range
Dim cell As Range
Dim value As String
Set range = Sheets("Sheet1").Range("E4:E15")
For Each cell In range
If Trim(cell.Value) <> "" Then
value = cell.Value
Else
cell.Value = value
End if
Next cell
End Sub
I would like the user to enter the range (E4:E15) in userform. How to do the userform if its dependent only range? Thanks stackoverflow.com.
Put a text box in userform and name it txtRng. Then declare a variable named MyRng as String. Assign that text box value to MyRng variable and use this variable as argument of range like...
Set range = Sheets("Sheet1").Range(MyRng)
So, full code will be like as below
Sub fillblank()
Dim range As range
Dim cell As range
Dim value As String
Dim MyRng As String
MyRng = UserForm1.txtRng 'Use your form name here
Set range = Sheets("Sheet1").range(MyRng)
For Each cell In range
If Trim(cell.value) <> "" Then
value = cell.value
Else
cell.value = value
End If
Next cell
End Sub
I also suggest you to not use range, value as variable because some of these reserve keyword. It may cause misbehave of output.
You could use the InputBox() method and have the user select a range:
Sub fillblank()
Dim myRange As Range
Dim cell As Range
Dim myValue As String
Set myRange = Application.InputBox( prompt:="Select a range", Type:=8)
For Each cell In myRange
If Trim(cell.Value) <> "" Then
myValue = cell.Value
Else
cell.Value = myValue
End if
Next
End Sub
or you could add a RefEdit control to your userform and process it
Sub fillblank()
Dim cell As range
Dim myValue As String
For Each cell In range(Me.RefEdit1.Text)
If Trim(cell.value) <> "" Then
myValue = cell.value
Else
cell.value = myValue
End If
Next cell
End Sub
In this case, since the user could input an invalid range, you may want to add a validation function (named GetRange in my following example)
Sub fillblank()
Dim myRange As range
If Not GetRange(Me.RefEdit1.Text, myRange) Then
MsgBox "Select a valid range "
Me.RefEdit1.SetFocus
Exit Sub
End If
Dim cell As range
Dim myValue As String
For Each cell In myRange
If Trim(cell.value) <> "" Then
myValue = cell.value
Else
cell.value = myValue
End If
Next cell
End Sub
Function GetRange(RefEditText As String, myRange As range) As Boolean
On Error Resume Next
Set myRange = range(RefEditText)
On Error GoTo 0
GetRange = Not myRange Is Nothing
End Function
finally, here is an alternative method (no loops) to fill blank cells as you're wanting to do:
Sub fillblank()
With range(Me.RefEdit1.Text).SpecialCells(xlCellTypeBlanks)
.FormulaR1C1 = "=R[-1]C"
.value = .value
End With
End Sub
To ask the user for a range you could use InputBox(Type:=8)
The code bellow will accept only one column
If an entire column is selected (A:A) or multiple columns it adjusts to the total rows in UsedRange and first column in selection
Option Explicit
Public Sub FillBlanks()
Dim selectedCol As Range, itm As Range, lr As Long
On Error Resume Next
Set selectedCol = Application.InputBox(Prompt:="Select column:", Type:=8)
On Error GoTo 0
If selectedCol Is Nothing Then Exit Sub 'User cancelled selection
With selectedCol
.Parent.Activate
lr = .Parent.UsedRange.Rows.Count
If .Columns.Count > 1 Then Set selectedCol = .Resize(.Rows.Count, 1)
If .Rows.Count < 2 Or .Rows.Count > lr Then Set selectedCol = .Resize(lr - .Row + 1, 1)
selectedCol.Select
End With
For Each itm In selectedCol
If Len(Trim$(itm)) = 0 And itm.Row > 1 Then itm.Value2 = itm.Offset(-1).Value2
Next
End Sub
Note: It's not recommended to name your variables with special VBA keywords
Dim range As Range - Range is the most important object in Excel
Dim value As String - Value is the most important property of the Range object
I have written a macro, which should read the value in every sheet (Row and Column) based on the value given it should Lock the cell or leave it unlocked. The way the code is written right now it takes forever to compute. I was suggested it be done using arrays. However the array are also not working
My excel file has got 15 sheets.
My Code is below.
Private Sub Workbook_Open()
Dim sh As Object
Dim sheetnames As String
Dim i As Integer
Dim col As Range
Dim rng As Variant: Set rng = Application.Range("I16:BI300") 'Value Lock & Unlock is in Column Range I16 to BI16 and Row Range B16 to B300
Dim rngCell As Variant
Application.ScreenUpdating = False
For Each sh In Sheets 'First Each
If sh.Name <> "Configuration" Then 'Configuration If
sheetnames = sh.Name
Worksheets(sheetnames).Activate
ActiveSheet.Unprotect Password:="sos"
For Each rngCell In Range("I22:BI300")
If (Cells(1, rngCell.Column) = "Lock" And Cells(rngCell.Row, 1) = "Lock") Or (Cells(1, rngCell.Column) = "UnLock" And Cells(rngCell.Row, 1) = "Lock") Or (Cells(1, rngCell.Column) = "Lock" And Cells(rngCell.Row, 1) = "Unlock") Then
rngCell.Locked = True
rngCell.Font.Color = -16776961
Else
rngCell.Locked = False
rngCell.Font.ColorIndex = xlAutomatic
End If
Next rngCell
ActiveSheet.Protect Password:="sos"
End If 'End of Configuration If
Next sh 'End of First Each
Sheets(1).Select
End Sub
Based on a combination of values in Column and Rows the result should produce values.
Column Row Value
Lock Lock Lock
Unlock Lock Lock
Lock Unlock Lock
Unlock Unlock Unlock
I'm not sure how arrays would speed this up as really it is the locking/unlocking of cells which is causing the main speed issue (Although arrays could improve the read time). Anyway, I'd suggest setting the values you wish to lock/unlock to a range and then doing them all in one go instead of individually as that will be where your main performance impact is.
Private Sub Workbook_Open()
Dim sh As Object
Dim sheetnames As String
Dim i As Integer
Dim col As Range, LockRng As Range, UnLockRng As Range
Dim rng As Variant: Set rng = Application.Range("I16:BI300") 'Value Lock & Unlock is in Column Range I16 to BI16 and Row Range B16 to B300
Dim rngCell As Variant
Application.ScreenUpdating = False
For Each sh In Sheets 'First Each
' Reset Ranges for each sheet
Set LockRng = Nothing
Set UnLockRng = Nothing
If sh.Name <> "Configuration" Then 'Configuration If
sheetnames = sh.Name
Worksheets(sheetnames).Activate
ActiveSheet.Unprotect Password:="sos"
For Each rngCell In Range("I22:BI300")
If (Cells(1, rngCell.Column) = "Lock" And Cells(rngCell.Row, 1) = "Lock") _
Or (Cells(1, rngCell.Column) = "UnLock" And Cells(rngCell.Row, 1) = "Lock") _
Or (Cells(1, rngCell.Column) = "Lock" And Cells(rngCell.Row, 1) = "Unlock") Then
' Create LockRng
If LockRng Is Nothing Then
Set LockRng = rngCell
Else
Set LockRng = Union(LockRng, rngCell)
End If
Else
' Create UnLockRng
If UnLockRng Is Nothing Then
Set UnLockRng = rngCell
Else
Set UnLockRng = Union(UnLockRng, rngCell)
End If
End If
Next rngCell
ActiveSheet.Protect Password:="sos"
End If 'End of Configuration If
' Lock all cells in LockRng
If Not LockRng Is Nothing Then
LockRng.Locked = True
LockRng.Font.Color = -16776961
End If
' Unlock all cells in UnLockRng
If Not UnLockRng Is Nothing Then
UnLockRng.Locked = False
UnLockRng.Font.ColorIndex = xlAutomatic
End If
Next sh 'End of First Each
Sheets(1).Select
End Sub
I have a list called "District List" on one tab and a Template that is driven by putting the name of a district into Cell C3. Each District has a wildly varying number of branches (between 1 & 500+ branches depending on the District) so the report template has a lot of blank space in some cases. I came up with this to loop through the District List, copy the Template tab, rename it the District Name, insert the name of the district into Cell C3, and then I have another loop to hide the blank rows.
It works, but it takes forever, like 5 minutes per tab, then after about four tabs, I get an object error at the first like of Sub CreateTabsFromList.
Is there a problem with the code, or is this just a really inefficient way to do this? If so can anyone help with a better method?
Sub HideRows()
Dim r As Range, c As Range
Set r = Range("a1:a1000") 'Sets range well beyond the last possible row with data
Application.ScreenUpdating = False
For Each c In r
If Len(c.Text) = 0 Then
c.EntireRow.Hidden = True 'Hide the row if the cell in A is blank
Else
c.EntireRow.Hidden = False
End If
Next c
Application.ScreenUpdating = True
End Sub
Sub CreateSheetsFromAList()
Dim MyCell As Range, MyRange As Range
Set MyRange = Sheets("District List").Range("A1")
Set MyRange = Range(MyRange, MyRange.End(xlDown))
For Each MyCell In MyRange
Sheets("Template").Copy After:=Sheets(Sheets.Count) 'creates a new worksheet
Range("C3").Value = MyCell.Value 'Pastes value in C3
Sheets(Sheets.Count).Name = MyCell.Value 'renames worksheet
HideRows 'Hides rows where cell in column A is ""
Next MyCell
End Sub
Deleting/Hiding rows, 1 by 1 is the slowest method. Always club them in one range and delete/hide them in one go, also looping through cells is slower than looping array.
Sub HideRows()
Dim lCtr As Long
Dim rngDel As Range
Dim r As Range
Dim arr
Set r = Range("a1:a1000") 'Sets range well beyond the last possible row with data
Application.ScreenUpdating = False
arr = r
For lCtr = LBound(arr) To UBound(arr)
If arr(lCtr, 1) = "" Then
If rngDel Is Nothing Then
Set rngDel = Cells(lCtr, 1) 'harcoded 1 as you are using column A
Else
Set rngDel = Union(rngDel, Cells(lCtr, 1))
End If
End If
Next
If Not rngDel Is Nothing Then
rngDel.EntireRow.Hidden=True
End If
Application.ScreenUpdating = True
End Sub
takes fraction of a second for 1000 rows.
I would like some support in correcting this simple piece of code. when running the code it is always displaying 1 and then a miss match error box pops up. I cant see why this is not working the code seems simple enough.
Sub Test3()
Dim rng As Range, cell As Range
Set rng = Range("D1:D10")
For Each cell In rng
If cell.Value > 0 Then
MsgBox Application.WorksheetFunction.CountA(cell.Value)
End If
Next cell
End Sub
Here is one way:
Sub Test3()
Dim rng As Range, cell As Range, IAmTheCount As Long
Set rng = Range("D1:D10")
IAmTheCount = 0
For Each cell In rng
If cell.Value > 0 Then
IAmTheCount = IAmTheCount + 1
End If
Next cell
MsgBox IAmTheCount
End Sub
Since you are using a for each loop, you are counting the cells one by one. That's why the Msgbox always says 1. You should not use a loop to achieve what you want
Sub Test3()
Dim rng As Range, cell As Range
Set rng = Range("D1:D10")
MsgBox Application.WorksheetFunction.CountIf(rng, ">0")
End Sub