I'm trying to build a VBA application that checks for a certain value, then adds a row on top for each time this value is found.
Sub copy()
Dim rng As Range
Dim row As Range
Dim cell As Range
Set rng = Range("B2:B10")
For Each row In rng.Rows
For Each cell In row.Cells
If cell.value = "test" Then
MsgBox "found" + cell.Address
cell.EntireRow.Insert
End If
Next cell
Next row
End Sub
Every time I try to run this function, however, it keeps adding rows on top of each other continuously and not for each occurrence.
If you loop the cells from top to bottom, adding the row will push your original range down, causing the next loop to evaluate the previous cell.
To avoid this, loop backwards (i.e. bottom to top):
Sub copy_test()
Dim rng As Range
Set rng = Range("B2:B10")
Dim i As Long
For i = rng.Cells.Count To 1 Step -1
If rng.Cells(i).Value = "test" Then
Debug.Print "Found"
rng.Cells(i).EntireRow.Insert
End If
Next i
End Sub
Note: Set rng = Range("B2:B10") is telling VBA that you are referring to Cells B2:B10 of the ActiveSheet which might not be what you want.
Please fully qualify your range to avoid this. (e.g. ThisWorkBook.Worksheets("Sheet1").Range("B2:B10") or use the code name of the worksheet Sheet1.Range("B2:B10").)
I am trying to run the same loop for a large validation list . The issue here is that that it always starts from the beginning (or top) of the data validation list, and I would like to start each time I run the macro, from the current selected value in the validation list and go to the next value down to the end. Any clue is much appreciated!
Dim dvCell As Range
Dim inputRange As Range
Dim c As Range
Dim i As Long
'Which cell has data validation
Set dvCell = Worksheets("ValperSIS").Range("e20")
'Determine where validation comes from
Set inputRange = Evaluate(dvCell.Validation.Formula1)
i = 1
'Begin our loop
Application.ScreenUpdating = False
For Each c In inputRange
dvCell = c.Value
If Range("CHECKSIS") = False Then
Exit For
End If
Sheets("ValperSIS").Copy After:=Sheets(Sheets.Count)
On Error Resume Next
ActiveSheet.Name = Range("e20").Value
On Error GoTo 0
ActiveSheet.Cells.Copy
ActiveSheet.Cells.PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
Next c
Maybe something like this ?
Suppose that the list is a named range in column-A called "data" in Sheet1.
The validation cell is A1 referring to list "=data" in Sheet2.
In Sheet2 worksheet module :
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("A1")) Is Nothing Then
With Sheets("Sheet2")
Set c = .Range("data").Find(Target.Value, lookat:=xlWhole)
Set Rng = .Range(c, c.End(xlDown))
For Each cell In Rng
MsgBox cell.Value 'the code to loop
Next
End With
End If
End Sub
When the user choose any item in the cell validation,
the loop will start from the selection to the end, for example:
Karma, you are right, I want the loop to stop when the "exit for" applies, and what that happens, I wanted to select the new starting value of the validation list till the nest "exit for" stops the loop-
Is it possible to write a vba macro that determines if there are any empty cells in a given range and returns the row number of that cell?
I'm new to vba and all that I managed to write after searching the internet was something that takes a range and colors every emty cell in it red:
Sub EmptyRed()
If TypeName(Selection) <> "Range" Then Exit Sub
For Each cell In Selection
If IsEmpty(cell.Value) Then cell.Interior.Color = RGB(255, 0, 0)
Next cell
End Sub
The macro does basically what I want, but instead of coloring the empty cell red I would like to know the row index of the empty cell.
A little background info: I have a very large file (about 80 000 rows) that contains many merged cells. I want to import it into R with readxl. Readxl splits merged cells, puts the value in the first split cell and NA into all others. But a completely empty cell would also be assigned NA, so I thought the best thing would be to find out which cells are empty with Excel, so that I know which NA indicate a merged cell or an empty cell. Any suggestions on how to solve this problem are very welcome, thanks!
Edit: To clarify: Ideally, I want to unmerge all cells in my document and fill each split cell with the content of the previously merged cell. But I found macros on the web that are supposed to do exactly that, but they didn't work on my file, so I thought I could just determine blank cells and then work on them in R. I usually don't work with Excel so I know very little about it, so sorry if my thought process is far too complicated.
To do exactly what you state in your title:
If IsEmpty(cell.Value) Then Debug.Print cell.Row
But there are also Excel methods to determine merged cells and act on them. So And I'm not sure exactly what you want to do with the information.
EDIT
Adding on what you say you want to do with the results, perhaps this VBA code might help:
Option Explicit
Sub EmptyRed()
Dim myMergedRange As Range, myCell As Range, myMergedCell As Range
Dim rngProcess As Range
With Application
.ScreenUpdating = False
.Calculation = xlCalculationManual
.EnableEvents = False
End With
Set rngProcess = Range("A1:B10")
For Each myCell In rngProcess
If myCell.MergeCells = True Then
Set myMergedRange = myCell.MergeArea
With myMergedRange
.MergeCells = False
.Value = myCell(1, 1)
End With
End If
Next myCell
With Application
.ScreenUpdating = True
.Calculation = xlCalculationAutomatic
.EnableEvents = True
End With
End sub
Note that I explicitly declare all variables, and I hard coded the range to check. There are various ways of declaring the range to be checked; using 'Selection' is usually rarely preferred.
Before anything else: From the opposite end of the spectrum, you can use Range.MergeCells or Range.MergeArea to determine if a Cell is part of a Merged Area. But, I digress...
You can use Cell.Row to get the row number. How you return or display that is up to you - could be a Message Box, a delimited string, or an array, or even a multi-area range.
A Sub cannot return anything once called, so you may want a Function instead, e.g. Public Function EmptyRed() As String
(Also, I would recommend you get in the habit of explicitly declaring all of your variables, and perhaps using Option Explicit too, before you run into a typo-based error. Just add Dim cell As Range at the top of the sub for now)
Sub FF()
Dim r, wksOutput As Worksheet
Dim cell As Range, rng As Range, rngArea As Range
With Selection
.UnMerge
'// Get only blank cells
Set rng = .SpecialCells(xlCellTypeBlanks)
'// Make blank cells red
rng.Interior.Color = vbRed
End With
'// Create output worksheet
Set wksOutput = Sheets.Add()
With wksOutput
For Each rngArea In rng.Areas
For Each cell In rngArea
r = r + 1
'// Write down the row of blank cell
.Cells(r, 1) = cell.Row
Next
Next
'// Remove duplicates
.Range("A:A").RemoveDuplicates Array(1), xlNo
End With
End Sub
There are a couple ways:
Sub EmptyRed()
Dim rgn,targetrgn as range
Dim ads as string ‘ return rgn address
Set targetrgn= ‘ your selection
For Each rgn In Targetrgn
If IsEmpty(rgn.Value) Then
‘1. Use address function, and from there you can stripe out the column and row
Ads=application.worksheetfunction.addres(cell,1)’ the second input control the address format, w/o $
‘2. Range.row & range.column
Ads=“row:” & rgn.row & “, col: “ & rgn.column
End if
Next rgn
End Sub
Ps: I edited the code on my phone and will debug further when I have a computer. And I am just more used to use “range” rather than “cell”.
To clarify: Ideally, I want to unmerge all cells in my document and fill each split cell with the content of the previously merged cell.
Cycle through all cells in the worksheet's UsedRange
If merged, unmerge and fill the unmerged area with the value from the formerly merged area.
If not merged but blank, collect for address output.
Sub fillMerged()
Dim r As Range, br As Range, mr As Range
For Each r In ActiveSheet.UsedRange
If r.Address <> r.MergeArea.Address Then
'merged cells - unmerge and set value to all
Set mr = r.MergeArea
r.UnMerge
mr.Value = mr.Cells(1).Value
ElseIf IsEmpty(r) Then
'unmerged blank cell
If br Is Nothing Then
Set br = r
Else
Set br = Union(br, r)
End If
End If
Next r
Debug.Print "blank cells: " & br.Address(0, 0)
End Sub
I made a code to hide some rows using .hidden = True that I don't need to show to make some checks, but I after that I want to show all the data again, so I made this code:
Sub show_hidden_cells()
Dim line As Range
Dim rng As Range
Set rng = Range("Tb_Data[Date]")
For Each line In rng
If line.SpecialCells(xlCellTypeVisible) = False Then
line.EntireRow.Hidden = False
End If
Next line
End Sub
My data has 50.000 rows and my computer it's not really fast, so I don't want to check every cell if is visible, instead of that I want to select only the hidden cells.
EDIT.
Thanks to #Rory and #Flephal who helped me my code now is:
Sub show_hidden_cells()
Dim rng As Range
Set rng = Range("Tb_Data[Date]")
rng.EntireRow.Hidden = False
End Sub
I am trying to produce a VBA function that will hide all columns for which cells D9:CC9 are not equal to "A6" and cells D8:CC8 are not equal to "12." Based on the script below, the system keeps returning an error. I am new to VBA, was hoping someone might be able to assist.
Thanks!
Dim MyCell As Range
Set MyCell = Range("D9:CC9,D8:CC8")
For Each cell In MyCell
If cell.Value <> WorksheetFunction.Index(Range("D9:CC9"),WorksheetFunction.Match(Range("A6")&"12",Range("D9:CC9")&Range("D8:CC8"), 0))
cell.EntireColumn.Hidden = True
End If
Next cell
Most operations are performed quite different using VBA than doing them manually. If you want to work with VBA then should do some research about working with variables and objects. This pages should be of interest.
Variables & Constants, Excel Objects, With Statement & Range Properties (Excel)
I have done some changes to your code, see comments within, and refer to the pages mentioned above.
Sub Rng_HideColumns()
Dim rTrg As Range, rCol As Range
Dim sCllVal As String
Rem Set rTrg = ThisWorkbook.Sheets("Sht(0)").Range("D9:CC9,D8:CC8")
Rem Refers to the worksheet you want to work with instead or using the active worksheet
With ThisWorkbook.Sheets("Sht(0)")
Rem Get value to match
sCllVal = .Range("A6").Value2 & 12
Rem Set Range to Search
Set rTrg = .Range("D8:CC9")
For Each rCol In rTrg.Columns
With rCol
If .Cells(2).Value2 & .Cells(1).Value2 = sCllVal Then
.EntireColumn.Hidden = 1
Else
.EntireColumn.Hidden = 0
End If: End With: Next: End With
End Sub