I want to return the value of the cell it's found in VBA and clear all of it's content with another 3 rows below it as well, but I'm currently stuck. I can find where the cell is coming from, but it's deleting the whole range instead of the specific range (I'm aware the range("A7:H20") was wrong). How do I select the correct range?
Sub Find_and_remove()
For Each cell In Range("A7:H20")
If cell.Value = Range("Q5") Then
'return the range of that cell and deleted it with 3 row below it'
Range("A7:H20").Clear
End If
Next cell
End Sub
Sub Find_and_remove()
Dim rng As Range
For Each rng In Range("A7:H20")
If rng.Value = Range("Q5") Then Range(rng, rng.Offset(3, 0)).Clear
Next cell
End Sub
Another solution:
I am using a sub to which you pass the parameters:
value to be found
range where to look in and clear contents
number of rows below the found value to be cleared.
Furthermore I am looking from the bottom to the top of the range - otherwise cells could be cleared that contain the string to be found - and then below values won't get cleared:
Option Explicit
'>>> example of how to call the findAndRemove-Sub <<<
Public Sub test_FindAndRemove()
With ActiveSheet ' adjust this to your needs
findAndRemove .Range("Q5"), .Range("A7:H20"), 3
End With
End Sub
'>>>> this is the sub that is doing the work <<<<<
Public Sub findAndRemove(strFind As String, _
rgLookup As Range, _
cntDeleteRowsBelow As Long)
Dim i As Long, c As Range
'start from the bottom and go up
'otherwise you could delete further strFind-cells unintentionally
For i = rgLookup.Rows.Count To 1 Step -1
For Each c In rgLookup.Rows(i).Cells
If c.Value = strFind Then
'ATTENTION:
'at this point there is no check if below row contains the strFind-value!
c.Resize(cntDeleteRowsBelow + 1).Clear
End If
Next
Next
End Sub
You could just use cell.Clear, or if you want the cell cleared and the next 3 below it use something like this
For i = 0 To 3
cell.Offset(i, 0).Clear
Next
I think you mean "return the address of that cell", no? Debug.Print(cell.Address) will get you this info. But you don't actually need it here. Instead of Range("A7:H20").Clear write cell.Resize(1 + i, 1).Clear with i = number of rows you want to clear along with cell itself (no need for a loop).
Related
I want to do some column formatting but column position is changing every time so how can i use column header instead of Column Alphabet ?
Sub Excel_Format()
Columns("J:J").Select
Selection.NumberFormat = "0"
Selection.Columns.AutoFit
End Sub
You need to start defining a Name for your column. The quickest way to do it is to select the column (Column J in this case) and enter a name in the range/cell selector on the top-left part of your Workbook. See image below:
I have named the column to "MyColumn". You can now use this as a reference in your code, like this:
Sub Excel_Format()
Dim Rng As Range
Set Rng = ActiveSheet.Range("MyColumn")
Rng.NumberFormat = "0"
Rng.Columns.AutoFit
End Sub
Even if you add or remove columns to the left of column J, the reference to MyColumn will remain correct
Please, try the next way. You can use it for any header, only adapting the used constant:
Sub Excel_Format()
Dim ws As Worksheet, RngH As Range
Const myColName As String = "ColumnX" 'your column header
Set ws = ActiveSheet 'use here your necessary sheet
Set RngH = ws.rows(1).Find(myColName)
If Not RngH Is Nothing Then
With RngH.EntireColumn
.NumberFormat = "0"
.AutoFit
End With
Else
MsgBox myColName & " could not be found in the sheet first row..."
End If
End Sub
The header should exist in the first sheet row. If not, you should adapt ws.rows(1).Find( writing the necessary row, instead of `...
Selecting, activating in such a context only consumes Excel resources, not bringing any benefit.
I have an IF statement working fine, but I need to use a VLookup as a range, as the cell that is the subject of the IF could be in a different row, but never a different column.
I'm brand new to VBA (but not to excel), so the VLookup was an instinctive move, but I'm not tied to it if I can achieve the same thing another way. I've been trying to find solutions online, but don't seem to actually answer this query.
The below is the original code with a static range.
Sub FINDTOTAL()
Dim Amount As String
Amount = "Subtotal"
thetotal = Application.WorksheetFunction.Vlookup(Amount, Sheet1.Range("G:H"), 2, False)
End Sub
Sub CalculateSubtotal()
If Range("H25") > 10000 Then
Sheets("Billing").Select
Else
Worksheets("Sheet1").Range("H25").Copy
MsgBox "Subtotal has been copied and can be pasted into the quote"
End If
End Sub
The VLookup works, and the IF statement works, I just can't get them to work together. I need the subtotal to be assessed for the IF statement regardless of where it is in the column (in probability, it could be anywhere between rows 3 - 50).
Maybe something like this:
Sub FindTotal()
Dim Total As Variant
Total = Application.VLookup("Subtotal", Sheet1.Range("G:H"), 2, False)
If Not IsError(Total) Then
If IsNumeric(Total) Then
If Total > 10000 Then
' Do one thing
Else
' Do another thing
End If
End If
End If
End Sub
If you want to write the total to another cell elsewhere, you don't need to copy, just a direct value transfer.
Demonstrating a Find/Offset approach:
Sub FindTotal()
Dim rng As Range
Set rng = Sheet1.Columns("G").Cells.Find(What:="Subtotal")
If Not rng Is Nothing Then
Dim totalRng As Range
Set totalRng = rng.Offset(, 1)
If IsNumeric(totalRng.Value) Then
If totalRng.Value > 10000 Then
' Do one thing
Else
' Do another thing
End If
End If
End If
End Sub
I'm making a college exercise and I need to check if some specific cells are blank. If they are blank, I need to write something in them. I've tried to make one program, but it did not worked, showing me the error: 13.
Here is my code:
Option Explicit
Sub Test()
If Range("a1:e1").Value = "" Then
Range("a1:e1") = "x"
End If
End Sub
Thank you for the help!
If a range contains 1 cell then its .Value property returns a single scalar value.
However, If a range contains multiple cells then its .Value property returns an Array.
You could iterate over all the cells in the range to see if they are all empty. Alternatively, you could use WorksheetFunction.CountBlank to see if the number of blanks in the range matches the number of cells in the range.
With Range("a1:e1")
If WorksheetFunction.CountBlank(.Cells) = .Cells.Count Then
Range("a1:e1") = "x"
End If
End With
It's not clear what you want to do in case one cell in this range is not empty.
Since the case where you want to fill the cells if they are all blank has been already covered, I will cover the case where you want to check if there are any blank cells in a range and if yes then fill them.
Dim cell As Range
For Each cell In Range("A1:E1").Cells
If cell.Value = "" Then
cell.Value = "x"
End If
Next cell
You could also use WorksheetFunction.CountA. It counts non empty cells. Like this:
If WorksheetFunction.CountA(Range("a1:e1")) = 0 Then
Range("a1:e1") = "x"
End If
It does the same as TinMan's code. But the check is differend.
You could try this code:
Sub Test()
Dim rng As Range
Set rng = Range("A1:E1")
' if we come upon non-empty cell we exit sub and do nothing
For Each cell In rng
If Not IsEmpty(cell) Then Exit Sub
Next
' if we reached this, all cells are empty
rng.Value = "x"
End Sub
I'm trying to make a vba code to check each cell in two sheets if they are equal. If not, create an empty row above and move on for both of the sheets.
I don't have much experience using Vba so I'm a little confused. I hope you've understood my problem and a appreciate since now.
Private Sub compare_cells(ByVal Target As Range)
If Target Is Nothing Then Next
If Cells(Target.Row, 1).Value = 'another row ' Cells(Target.Row, 4).Value Then
Next
Else
'inset empty row above of the sheet with the missing value
Next
End If
End Sub
The code above is really ugly, that's why I need help. The data seems like this:
sheet 1:
sheet 2:
If my understanding is correct in your question above... You want to produce an empty row, above ANY values that DO NOT match between two worksheets.
Based on this, and the above code, you are not too FAR off the right track.
Try the below code...
Private Sub compare_cells(ByVal Target1 As Range, ByVal Target2 As Range)
If Target1 Is Nothing Then Exit Sub
If Target2 Is Nothing Then Exit Sub
Dim ws1, ws2 As Worksheet
Set ws1 = Sheets(Target1.Parent.Name)
Set ws2 = Sheets(Target2.Parent.Name)
If Target1.Value <> Target2.Value Then
' If they don't match place your code here
ws1.Range(Target1.Row & ":" & Target1.Row).Insert Shift:=xlDown
ws2.Range(Target2.Row & ":" & Target2.Row).Insert Shift:=xlDown
End If
End Sub
You can call this by using this within another macro...
Call compare_cells(Sheets("Sheet1").Range("A1"), Sheets("Sheet2").Range("D1"))
If you use the above macro, then this will compare Range "A1" on Sheet1, with Range "D1" on Sheet 2. If these two cells do not match, then it will insert a row above both A1, and D1.
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