I am not a Genius in Excel VBA, so here is my question:
I have an Excel Sheet which has hidden rows.
For example: As long as cell A1 is empty keep the row(A2) hidden. When A1 includes text show the next row (A2).
My Approach was the following:
Sub showRows_Klicken()
Dim rng As Range
For Each rng In Range(Cells(1, 1), Cells(65536, 1).End(xlUp))
If LCase(rng) = "text"
Then
rng.EntireRow.Hidden = False
Else
End If
Next rng
End Sub
I hope somebody can help me out here.
Thanks in advance.
I tried this code. Worked for me. Please give it a try
Sub Macro1()
If Range("A1").Value = vbNullString Then
Columns("B:B").EntireColumn.Hidden = True
ElseIf Not IsEmpty(Range("A1").Value) Then
Columns("B:B").EntireColumn.Hidden = False
End If
End Sub
The Hidden property seems to work. I've changed the function a bit such that it sets the next row (i+1) visible based on row i. It now only checks each 2nd row, otherwise you could hide all rows (if there were nothing), and you would not be able to set any "text" such that the next row is unhidden:
Sub showRows_Klicken()
'loop all rows
For i = 1 To 65536 Step 2
'check if has string "text" and set hidden
If LCase(Cells(i, 1)) = "text" Then
Range(Cells(i + 1, 1), Cells(i + 1, 1)).EntireRow.Hidden = False
Else
Range(Cells(i + 1, 1), Cells(i + 1, 1)).EntireRow.Hidden = True
End If
Next i
End Sub
Thanks for your help, I changed the code a bit and now it works for me:
Sub Schaltfläche259_Klicken()
If Range("A1").Value = vbNullString Then
Rows("2").EntireRow.Hidden = True
ElseIf Not IsEmpty(Range("A1").Value) Then
Rows("2").EntireRow.Hidden = False
End If
End Sub
Related
I'm currently working on a code that hides empty cells ,but the problem is i want it to start hiding at a certain range ("A9:A12") not at the beginning of the sheet.
here is my program :
Sub EmptyRow()
'Dim s As String
po = Range("A9:A12").Count
Range("A8").Activate
For i = 1 To po
s = i & ":" & i
If IsEmpty(Cells(i, 1).Value) Then
Rows(s).Select
Selection.EntireRow.Hidden = True
End If
Next
End Sub
The program keeps on hiding cells from the beginning, how do I set it up so it deletes from the range i want it to. Please help.
You can even make your code shorter like this:
For i = 9 To 12
Cells(i, 1).EntireRow.Hidden = IsEmpty(Cells(i, 1).Value)
Next i
Thus, the result of the Hidden property would be dependent on whether the Cells(i,1) is empty. It is easier to understand and to maintain.
Check the solution below. In case you need to change your affected area, just change the value of targetRange.
Sub EmptyRow()
Dim targetRange as Range, po as Long, i as Long
Set targetRange = Range("A9:A12")
po = targetRange.Count
With targetRange
For i = 1 To po
If IsEmpty(.Cells(i, 1).Value) Then
.Rows(i).EntireRow.Hidden = True
End If
Next
End With
End Sub
Sheets("Sheet1").Range("A9:A12").SpecialCells(xlCellTypeBlanks).EntireRow.Hidden = True
SpecialCells results in run-time error if no cells are found, but that can be checked:
If [CountBlank(Sheet1!A9:A12)] Then _
[Sheet1!A9:A12].SpecialCells(xlCellTypeBlanks).EntireRow.Hidden = True
or ignored:
On Error Resume Next
[Sheet1!A9:A12].SpecialCells(xlCellTypeBlanks).EntireRow.Hidden = True
You can get rid of bits like select
Sub EmptyRow()
For i = 9 To 12
If IsEmpty(Cells(i, 1).Value) Then
Cells(i, 1).EntireRow.Hidden = True
End If
Next i
End Sub
I can't finish the last part of my code if anyone could assist. When a cell is not a number I need it to delete the data in the cell.
Try the code below:
Sub ValueOnly()
Dim x As Integer
Application.ScreenUpdating = False
With Sheets("Consolidated Data")
For x = 1 To 3107
With .Cells(10 + x, 9)
If Not IsNumeric(.Value) Then .ClearContents
End With
With .Cells(10 + x, 10)
If Not IsNumeric(.Value) Then .ClearContents
End With
Next x
End With
End Sub
since IsNumeric() can have issues, you may want to try a SpecialCells() approach, which is a little trickier:
Option Explicit
Sub ValueOnly()
Dim numericRng As Range, lastNumericRng As Range, lastRng As Range
Dim iArea As Long
With Sheets("Consolidated Data").Range("I11:I3317").SpecialCells(xlCellTypeConstants) '<--| consider only your wanted range "not blank" values
Set numericRng = .SpecialCells(xlCellTypeConstants, xlNumbers) '<--| store "numeric" values
If Intersect(.Cells(1), numericRng) Is Nothing Then '<--| check if first value is not numeric
.Parent.Range(.Cells(1), numericRng(1).Offset(-1)).ClearContents
End If
With numericRng
For iArea = 2 To .areas.Count '<--| clear all not numeric values between numeric ones
.Parent.Range(.areas(iArea - 1).Offset(.areas(iArea - 1).Count).Resize(1), _
.areas(iArea).Resize(1).Offset(-1)).ClearContents
Next
End With
Set lastRng = .areas(.areas.Count).Cells(.areas(.areas.Count).Count)
If Intersect(lastRng, numericRng) Is Nothing Then '<--| check if last value is not numeric
With numericRng
Set lastNumericRng = .areas(.areas.Count).Offset(.areas(.areas.Count).Count).Resize(1)
End With
.Parent.Range(lastNumericRng, lastRng).ClearContents
End If
End With
End Sub
Needing help with the following.
I want for the first column: To auto fill the remaining blank spaces until another value is found. Example: RMDSADMN would be autofilled until TXAADGLI is found, then this would be autofilled until TXAADM, then this would get filled one time since there is one blank space.
I tried adding input boxes where I had to manually insert the name of each value but I am aiming for something that automatically checks the values, instead of me inserting them.
Try,
with activesheet
with .cells(1,1).currentregion
.specialcells(xlcelltypeblanks).formular1c1 = "=r[-1]c"
.value = value
end with
end with
Try this:
Sub test()
Dim lRow As Integer
Dim i As Integer
lRow = Cells(Rows.Count, 5).End(xlUp).Row
With ThisWorkbook.ActiveSheet
For i = 1 To lRow
If .Cells(i, 1).Value = "" Then
.Cells(i, 1).Value = .Cells(i - 1, 1).Value
End If
Next i
End With
End Sub
Can be achieved easily without VBA:
Enter something in first row after last blank (same column), select from RMDSADMIN down to that something, =, Up, Ctrl + Enter.
The following code can help is there you need to auto-fill the previous values between 1st and last cells depending on value of 1st cell as mentioned in question Excel - VBA fill in cells between 1st and Last value
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim i As Long
For i = 2 To Target.Column
If Cells(Target.Row, i) = "" Then
If Cells(Target.Row, i - 1) <> "" Then
Range(Cells(Target.Row, i), Cells(Target.Row, i)).Value = Range(Cells(Target.Row, i - 1), Cells(Target.Row, i - 1)).Value
End If
End If
Next i
End Sub
This sub is activated by clicking on any cell.
Same cell marks the end of the loop i.e. to stop the loop just click the cell till which you want to fill the blank cells.
Update: this can be similarly done for other way round as well as asked in this question.
I'm trying to loop through a particular range in my Excel spreadsheet(("B13:B65"), to be specific) and hide all rows that have an "X" in them. Something like this:
For i = 13 to 65
If Cells(i, 2) = "x" Or "X" Then Rows(i).RowHeight = 0
Next i
The problem is that I'm getting a type mismatch error.
I assume this is happening because all the cells in this range are formulas rather than text strings. For example, the contents of cell B13 are:
='Monthly'!$C$13
I want my code to evaluate the visible output of the cell, not the actual content.
I get the feeling there's a very easy solution here, but I've been searching for a while with no success. I'm a rookie, obviously...
Based on this example: https://msdn.microsoft.com/en-us/library/office/ff195193.aspx
Sub Main()
For Each c in Worksheets("Sheet1").Range("A1:D10") 'Change for your range
If Lcase(c.Value) = "x" Then
'''Rest of your code
End If
Next c
end sub
You're getting the error because of the OR. There has to be something that can be evaluated to true or false after the Or. Or "X" won't ever be true or false. You need...
If Cells(i, 2) = "x" Or Cells(i, 2) = "X" Then Rows(i).RowHeight = 0
As long as you wanted to use the same code everywhere else.
Use Value property:
If Cells(i, 2).Value = "x"
Loop through static range
Dim rng As Range, c As Range
Set rng = Range("B13:B65")
For Each c In rng.Cells
If UCase(c) = "X" Then
c.EntireRow.Hidden = True
End If
Next c
You could use an AutoFilter
Sub HideEm()
Dim rng1 As Range
Set rng1 = ActiveSheet.Range("$B$1:$B$65")
rng1.Parent.AutoFilterMode = False
rng1.AutoFilter Field:=1, Criteria1:="<>x", Operator:=xlOr, Criteria2:="<>X"
End Sub
I am a noob in vba. However, I would like to implement the following use case to make my cooperate life a lot of easier.
I have the following data:
I would like to copy the first row down until I hit a filled field, the second row also down until I hit a filled field, the third row up and down and the 4th row up.
This is how I would like to have my result sheet should look like.
Any recommendation how to implement this use case in vba?
I appreciate your replies!
can you please try this one? This routine is assuming column G as main start point and checks if column A,B,C,D is empty or not in the same row and fill it up accordingly.
Sub ASD()
Dim lastRow As Long
lastRow = Range("G" & Rows.Count).End(xlUp).Row
For Each c In Range("G:G")
If c.Value <> "" Then
If c.Offset(0, -3).Value = "" Then
c.Offset(0, -3).Value = c.Offset(0, -3).End(xlDown).Value
End If
If c.Offset(0, -4).Value = "" Then
c.Offset(0, -4).Value = c.Offset(0, -4).End(xlUp).Value
End If
If c.Offset(0, -5).Value = "" Then
c.Offset(0, -5).Value = c.Offset(0, -5).End(xlUp).Value
End If
If c.Offset(0, -6).Value = "" Then
c.Offset(0, -6).Value = c.Offset(0, -6).End(xlUp).Value
End If
End If
Next c
End Sub
Only problem is it do not do anything if the reference cell is empty in the column G. I think you don't need that anyway.
Hope this help.
It will run on your current selection
Copy the whole code into a module, run the fill_down() to fill down, fill_up() to fill up.
'======================
'******Filling*********
'======================
Sub fill_up()
Selection.SpecialCells(xlCellTypeBlanks).Select
Selection.FormulaR1C1 = "=R[1]C"
End Sub
Sub fill_down()
Call copy_last(Selection)
Call filling
End Sub
Function copy_last(r As range)
Dim arr() As Variant
Dim x As Double
Dim arr_size As Double
arr = r
arr_size = UBound(arr, 1)
For x = arr_size To 1 Step -1
If Not isempty(arr(x, 1)) Then
Exit For
End If
Next x
r(r.Row, 1) = arr(x, 1)
End Function
Function filling()
Selection.SpecialCells(xlCellTypeBlanks).Select
Selection.FormulaR1C1 = "=R[-1]C"
End Function
'=======================
'******End filling******
'=======================