Excel VBA for each selected row change value in column x - vba

This should have been easy, but im struggling.
Looking for a fast code to apply on user selected range.
For each row user has selected set new value in column x.

Try:
Sub Test()
Dim Rng As Range
Set Rng = Selection
For Each rr In Rng.Rows
Range("X" & rr.Row).Value = "new value"
Next
End Sub

Related

Fill Empty Blank Cells with value within a region horizontaly defined

I'm trying to fill blank cells in a certain region with 0. The reagion should be defined in the current workbook but in sheet2 (not the current sheet). Also the place where it is supposed to fill is between columns
BU:CQ in the current region (not all 100 000 000 lines). Just the number of lines that define the table between columns BU and CQ. I know the problem lies in defining the region... See the code below.
What is missing?
Sub FillEmptyBlankCellWithValue()
Dim cell As Range
Dim InputValue As String
On Error Resume Next
InputValue = "0"
For Each cell In ThisWorkbook.Sheets("Sheet2").Range(BU).CurrentRegion
'.Cells(Rows.Count, 2).End(xlUp).Row
If IsEmpty(cell) Then
cell.Value = InputValue
End If
Next
End Sub
I've this code that i'm positive that works! But i don't wnat selection! I want somthing that specifies the sheet and a fixed range.
Now my idea is to replace "selection" with the desired range. - In this case in particular the range should be 1 - between BU:CQ; 2 - starting at row 2; 3 - working the way down until last row (not empty = end of the table that goes from column A to DE)
Sub FillEmptyBlankCellWithValue()
Dim cell As Range
Dim InputValue As String
On Error Resume Next
For Each cell In Selection
If IsEmpty(cell) Then
cell.Value = "0"
End If
Next
End Sub'
PS: And I also need to specify the sheet, since the button that will execute the code will be in the same workbook but not in the same sheet.
Use SpecialsCells:
On Error Resume Next 'for the case the range would be all filled
With ws
Intersect(.UsedRange, .Range("BU:CQ")).SpecialCells(xlCellTypeBlanks).Value = 0
End With
On Error GoTo 0
MUCH faster than looping !
Try using cells() references, such as:
For i = cells(1,"BU").Column to cells(1,"CQ").Column
cells(1,i).value = "Moo"
Next i
In your current code you list Range(BU) which is not appropriate syntax. Note that Range() can be used for named ranges, e.g., Range("TheseCells"), but the actual cell references are written as Range("A1"), etc. For Cell(), you would use Cells(row,col).
Edit1
With if statement, with second loop:
Dim i as long, j as long, lr as long
lr = cells(rows.count,1).end(xlup).row
For i = 2 to lr 'assumes headers in row 1
For j = cells(1,"BU").Column to cells(1,"CQ").Column
If cells(i,j).value = "" then cells(i,j).value = "Moo"
Next j
Next i
First off, you should reference the worksheet you're working with using:
Set ws = Excel.Application.ThisWorkbook.Worksheets(MyWorksheetName)
Otherwise VBA is going to choose the worksheet for you, and it may or may not be the worksheet you want to work with.
And then use it to specify ranges on specific worksheets such as ws.Range or ws.Cells. This is a much better method for specifying which worksheet you're working on.
Now for your question:
I would reference the range using the following syntax:
Dim MyRange As Range
Set MyRange = ws.Range("BU:CQ")
I would iterate through the range like so:
Edit: I tested this and it works. Obviously you will want to change the range and worksheet reference; I assume you're competent enough to do this yourself. I didn't make a variable for my worksheet because another way to reference a worksheet is to use the worksheet's (Name) property in the property window, which you can set to whatever you want; this is a free, global variable.
Where I defined testWS in the properties window:
Public Sub test()
Dim MyRange As Range
Dim tblHeight As Long
Dim tblLength As Long
Dim offsetLen As Long
Dim i As Long
Dim j As Long
With testWS
'set this this to your "BU:CQ" range
Set MyRange = .Range("P:W")
'set this to "A:BU" to get the offset from A to BU
offsetLen = .Range("A:P").Columns.Count - 1
'set this to your "A" range
tblHeight = .Range("P" & .Rows.Count).End(xlUp).Row
tblLength = MyRange.Columns.Count
End With
'iterate through the number of rows
For i = 1 To tblHeight
'iterate through the number of columns
For j = 1 To tblLength
If IsEmpty(testWS.Cells(i, offsetLen + j).Value) Then
testWS.Cells(i, offsetLen + j).Value = 0
End If
Next
Next
End Sub
Before:
After (I stopped it early, so it didn't go through all the rows in the file):
If there's a better way to do this, then let me know.

Excel [VBA] Select Column within Table and insert data to empty cells

I have a table where sometimes there is data missing in the Column G (7th).
So far I selected a range in this column with my mouse and then ran this macro to fill empty cells with "No Data":
Sub FillEmptyCell()
Dim cell As Range
Dim InputValue As String
For Each cell In Selection
If IsEmpty(cell) Then
cell.Value = "No Data"
End If
Next
End Sub
However data in that column keeps getting more and I would like to automatically select the entire table range of the 7th column and fill empty cells with "No Data".
How do I implement this?
Try this
Dim lr As Long
lr = Cells(Rows.Count, 7).End(xlUp).Row
Dim Rng As Range
Set Rng = Range("G1:G" & lr)
For Each cell In Rng
If IsEmpty(cell) Then
cell.Value = "No Data"
End If
Next

Searching for greater than 1 value in a column Excel VBA

Anybody knows here how to look for a value that is greater than 1 in a column?
Set fileSheet = wb.ActiveSheet
fileSheet.Name = "Test"
Set rng = fileSheet.Range("D:D")
Set rngFound = rng.Find(">1")
If rngFound Is Nothing Then
MsgBox "No value"
End If
I'm trying to do it that way, but I know that if you put a double qoute, it will be treated as a String, so is there any way I can look for a greater than 1 value before filtering it? Please note that I will be working with a column that has thousands of data.
This should speed things up, assuming the cells contain numbers rather than formulas. An array would be much quicker, but depends what exactly you are trying to achieve.
Sub x()
Dim r As Range, filesheet As Worksheet, Rng As Range
Set filesheet = wb.ActiveSheet
filesheet.Name = "Test"
Set Rng = filesheet.Range("D1", filesheet.Range("D" & Rows.Count).End(xlUp)).SpecialCells(xlCellTypeConstants, xlNumbers)
For Each r In Rng
If r.Value > 1 Then
'do whatever
End If
Next r
End Sub
Use two for cycles for the index of last column and row like this.
Or, use the active sheet's range's foreach cycle.
More info:
How to iterate through all the cells in Excel VBA or VSTO 2005
displays cells that are > 1 for the range D1 to D100
Dim i As Integer
With ThisWorkbook.Sheets(1)
For i = 1 To 100
If .Cells(i,4).Value > 1 Then
MsgBox "Value Found! Cell D " & i
End If
Next i
End With

How to delete the last cell in a column that contains data

This sounds like a very basic question (and it is), but I cannot figure it out and I cannot find a suitable solution on the web.
How do you select the last cell in a column that contains a numeric value and delete it?
I have formulas that go past this cell and return blank values in the column. This is what is tripping me up at the moment. My current code will go all the way down to where I have carried the formulas to and start deleting those cells instead of deleting the last cell with a numeric value.
My current code looks like this
Range("AA1500").End(xlUp).Select
With Selection.Delete
End With
Any help would be greatly appreciated.
Please let me know if I can clarify anything.
Thanks
If you want to go down past cells with arbitrary strings in them and
delete the last numeric value (but not the last cell with a alphanumeric string in it), this should work:
Sub deleteLastNum()
Dim row As Integer
row = Range("A1000").End(xlUp).row
For i = row To 1 Step -1:
If IsNumeric(Cells(i, "A")) Then
Cells(i, "A").Clear
Range("A" & CStr(i + 1), "A" & CStr(row)).Cut Destination:=Range("A" & CStr(i))
Exit For
End If
Next
End Sub
It will also delete the last cell with a formula that evaluates to a number. It moves down the range of cells in the column above it with characters in it to fill in the cleared cell.
What you can do is get the total number of rows of a column (A) then check is last cell value is numeric or not, if numeric then clear that cell.
Sub del()
Dim sh As Worksheet
Dim rn As Range
Set sh = ThisWorkbook.Sheets("Sheet1")
Dim k As Long
Set rn = sh.UsedRange
k = rn.Rows.Count + rn.Row - 1
If IsNumeric(Sheets("Sheet1").Range("A" & k).Value) = True Then
Sheets("Sheet1").Range("A" & k).ClearContents
End If
End Sub
This will check last cell for numeric value in column A.
Hope this is what you are asking.
EDIT
Implementing above for all the sheets in a workbook using a loop is like :
Sub del()
Dim sh As Worksheet
Dim rn As Range
For Each sh In ActiveWorkbook.Worksheets
Set sh = ThisWorkbook.Sheets(sh.Name)
Dim k As Long
Set rn = sh.UsedRange
k = rn.Rows.Count + rn.Row - 1
If IsNumeric(sh.Range("A" & k).Value) = True Then
sh.Range("A" & k).ClearContents
End If
Next sh
End Sub
This will loop through each sheet like Sheet1, Sheet2 or whatever the name of the sheet may be and check for numeric value in last cell of col A, if found numeric then it will delete the value.
You already got an answer to your post, just to be clear, the safest way to find the last row (let's say in Column "AA", according to your post), and ignoring blank cells in the middle, is by using the syntax below:
Sub FindlastRow()
Dim LastRow As Long
With Worksheets("Sheet1") ' <-- change "Sheet1" to your sheet's name
LastRow = .Cells(.Rows.Count, "AA").End(xlUp).Row
' rest of your coding here
End With
End Sub
Screen-shot of the result:
Use 'SpecialCells()'
Sub ClearLastNumber(sh As WorkSheet, columnIndex As String)
On Error GoTo ExitSub 'should 'columnIndex' column of 'sh' worksheet contain no numbers then the subsequent statement would throw an error
With sh.Columns(columnIndex).SpecialCells(xlCellTypeConstants, xlNumbers)
With .Areas(.Areas.Count)
.Cells(.Count).ClearContents
End With
End With
ExitSub:
End Sub
To be used in your "main" sub as follows
Sub Main()
Dim sh As Worksheet
For Each sh In ActiveWorkbook.Worksheets
ClearLastNumber Sh "A"
Next
End Sub

Highlighting duplicates in different color based on column value

Could you please suggest me how to highlight the duplicates in the same way, but based on the column Value.
eg:
Column A1 has the value "ID", B1 has "Name", C1 has "Title".
I wanna highlight the dups if column x1 is ID or Name alone. ("x" may be any column in the active worksheet).
I dont know how to proceed further since I'm a beginner to VBA
It's also fine if you append your code to the previous one.
I would be very thankful to you if you do this for me.
if I am understanding you want to highlight duplicates in your Worksheet,
try the following code, it will highlight as you add duplicate values to columns
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim xlRng As Range
Dim xlCel As Range
Dim xlCol As Range
Dim C As Range
Dim XlStri As String
'// Duplicates will be highlighted in red
Target.Interior.ColorIndex = xlNone
For Each xlCol In Target.Columns
Set xlRng = Range(Cells(1, xlCol.Column), Cells(Rows.Count, xlCol.Column).End(xlUp))
Debug.Print xlRng.Address
For Each xlCel In xlCol
If WorksheetFunction.CountIf(xlRng, xlCel.Value) > 1 Then
Set C = xlRng.Find(What:=xlCel.Value, LookIn:=xlValues)
If Not C Is Nothing Then
XlStri = C.Address
Do
C.Interior.ColorIndex = 3
Set C = xlRng.FindNext(C)
Loop While Not C Is Nothing And C.Address <> XlStri
End If
End If
Next
Next xlCol
End Sub
To use the above code you need to put into the worksheet change event for the worksheet.
Go to the worksheet you want to changes
Go to the bottom, where the worksheet name appears (e.g. "Sheet1")
Right click and select "View Code"
Hope this helps