Via the following code
Sub Macro1()
Worksheets("Sheet1").Rows("1:1").SpecialCells(xlCellTypeBlanks).Select
End Sub
I can select the empty cells in a row. Is there a way to retrieve all cell references of these cells? With cell references I mean x and y in
Cells(x,y)
This would do it: -
Public Sub Sample()
Dim Rng As Range
Dim Cl As Range
Worksheets("Sheet1").Rows("1:1").SpecialCells(xlCellTypeBlanks).Select
Set Rng = Selection
For Each Cl In Rng.Cells
Debug.Print "Row: " & Cl.Row & ", Column: " & Cl.Column
Next
Set Rng = Nothing
End Sub
Your line of code selected what you wanted, the code references that selection as Rng using Selection. It then loops through each item in Rng as Cl.
The Select and Selection in Gary's answer are not recommend. Consider using the below for a more concise and efficient method of achieving the same thing.
Public Sub Sample()
Dim Cl As Range
For Each cl In Worksheets("Sheet1").Rows("1:1").SpecialCells(xlCellTypeBlanks).Cells
Debug.Print "Row: " & Cl.Row & ", Column: " & Cl.Column
Next
End Sub
Related
I have this code (This code is in Access VBA which tries to read an excel file and after checking, possibly import it):
Set ExcelApp = CreateObject("Excel.application")
Set Workbook = ExcelApp.Workbooks.Open(FileName)
Set Worksheet = Workbook.Worksheets(1)
now I want to iterate over all rows of the excel worksheet. I want something such as this:
for each row in Worksheet.rows
ProcessARow(row)
next row
where
function ProcessARow(row as ???? )
' process a row
' how Should I define the function
' how can I access each cell in the row
' Is there any way that I can understand how many cell with data exist in the row
end function
My questions:
How to define the for each code that it iterate correctly on all
rows that has data?
How to define ProcessARow properly
How to get the value of each cell in the row.
How to find how many cell with data exist in the row?
Is there any way that I detect what is the data type of each cell?
edit 1
The link solves on problem :
How to define the for each code that it iterate correctly on all rows that has data?
but what about other questions?
For example, how to define ProcessARow correctly?
If you need the values in the Row, you need use the 'Value' Property and after do an cycle to get each value
for each row in Worksheet.rows
Values=row.Value
For each cell in Values
ValueCell=cell
next cell
next row
Unfortunately you questions are very broad however I believe the below sub routine can show you a few ways of achieving what you are after. In regards to what datatype each cell is more involved as it depends what data type you wish to compare it to however I have included some stuff to hopefully help.
sub hopefullyuseful()
dim ws as worksheet
dim rng as Range
dim strlc as string
dim rc as long, i as long
dim lc as long, j as long
dim celltoprocess as range
set ws = activeworkbook.sheets(activesheet.name)
strlc = ws.cells.specialcells(xlcelltypeLastCell).address
set rng = ws.range("A1:" & lc)
rc = rng.rows.count()
debug.print "Number of rows: " & rc
lc = rng.columns.count()
debug.print "Number of columns: " & lc
'
'method 1 looping through the cells'
for i = 1 to rc
for j = 1 to lc
set celltoprocess = ws.cells(i,j)
'this gives you a cell object at the coordinates of (i,j)'
'[PROCESS HERE]'
debug.print celltoprocess.address & " is celltype: " & CellType(celltoprocess)
'here you can do any processing you would like on the individual cell if needed however this is not the best method'
set celltoprocess = nothing
next j
next i
'method 2 looping through the cells using a for each loop'
for each celltoprocess in rng.cells
debug.print celltoprocess.address & " is " & CellType(celltoprocess)
next celltoprocess
'if you just need the data in the cells and not the actual cell objects'
arrOfCellData = rng.value
'to access the data'
for i = lbound(arrOfCellData,1) to ubound(arrOfCellData,1)
'i = row'
for j = lbound(arrOfCellData,2) to ubound(arrOfCellData,2)
'j = columns'
debug.print "TYPE: " & typename(arrOfCellData(i,j)) & " character count:" & len(arrOfCellData(i,j))
next j
next i
set rng=nothing
set celltoprocess = nothing
set ws = nothing
end sub
Function CellType(byref Rng as range) as string
Select Case True
Case IsEmpty(Rng)
CellType = "Blank"
Case WorksheetFunction.IsText(Rng)
CellType = "Text"
Case WorksheetFunction.IsLogical(Rng)
CellType = "Logical"
Case WorksheetFunction.IsErr(Rng)
CellType = "Error"
Case IsDate(Rng)
CellType = "Date"
Case InStr(1, Rng.Text, ":") <> 0
CellType = "Time"
Case IsNumeric(Rng)
CellType = "Value"
End Select
end function
sub processRow(byref rngRow as range)
dim c as range
'it is unclear what you want to do with the row however... if you want
'to do something to cells in the row this is how you access them
'individually
for each c in rngRow.cells
debug.print "Cell " & c.address & " is in Column " & c.column & " and Row " & c.row & " has the value of " & c.value
next c
set c = nothing
set rngRow = nothing
exit sub
if you want your other questions answered you will have to be more specific as to what you are trying to accomplish
While I like the solution offered by #krazynhazy I believe that the following solution might be slightly shorter and closer to what you asked for. Still, I'd use the CellType function offered by Krazynhazy rather than all the Iif I currently have in the below code.
Option Explicit
Sub AllNonEmptyCells()
Dim rngRow As Range
Dim rngCell As Range
Dim wksItem As Worksheet
Set wksItem = ThisWorkbook.Worksheets(1)
On Error GoTo EmptySheet
For Each rngRow In wksItem.Cells.SpecialCells(xlCellTypeConstants).EntireRow.Rows
Call ProcessARow(wksItem, rngRow.Row)
Next rngRow
Exit Sub
EmptySheet:
MsgBox "Sheet is empty." & Chr(10) & "Aborting!"
Exit Sub
End Sub
Sub ProcessARow(wksItem As Worksheet, lngRow As Long)
Dim rngCell As Range
Debug.Print "Cells to process in row " & lngRow & ": " & wksItem.Range(wksItem.Cells(lngRow, 1), wksItem.Cells(lngRow, wksItem.Columns.Count)).SpecialCells(xlCellTypeConstants).Count
For Each rngCell In wksItem.Range(wksItem.Cells(lngRow, 1), wksItem.Cells(lngRow, wksItem.Columns.Count)).SpecialCells(xlCellTypeConstants)
Debug.Print "Row: " & lngRow, _
"Column: " & rngCell.Column, _
"Value: " & rngCell.Value2, _
IIf(Left(rngCell.Formula, 1) = "=", "Formula", IIf(IsDate(rngCell.Value), "Date", IIf(IsNumeric(rngCell.Value2), "Number", "Text")))
Next rngCell
End Sub
Note, that you have to call the sub to call a row must also include the sheet on which a row should be processed.
I have many cells that have #DIV/0! so I need to put the IFERROR function. Is there a way to apply this formula to all cells instead of putting the formula manually in every cell?
I tried this VBA code but I am looking for something more simple.
Sub WrapIfError()
Dim rng As Range
Dim cell As Range
Dim x As String
If Selection.Cells.Count = 1 Then
Set rng = Selection
If Not rng.HasFormula Then GoTo NoFormulas
Else
On Error GoTo NoFormulas
Set rng = Selection.SpecialCells(xlCellTypeFormulas)
On Error GoTo 0
End If
For Each cell In rng.Cells
x = cell.Formula
cell = "=IFERROR(" & Right(x, Len(x) - 1) & "," & Chr(34) & Chr(34) & ")"
Next cell
Exit Sub
'Error Handler
NoFormulas:
MsgBox "There were no formulas found in your selection!"
End Sub
Can anyone help me?
Perhaps one of these versions will be easier to teach.
Sub apply_Error_Control()
Dim cel As Range
For Each cel In Selection
If cel.HasFormula Then
'option 1
cel.Formula = Replace(cel.Formula, "=", "=IFERROR(", 1, 1) & ", """")"
'option 2
'cel.Formula = "=IFERROR(" & Mid(cel.Formula, 2) & ", """")"
End If
Next cel
End Sub
I've supplied two ways to apply the IFERROR function as a 'wapper' for error control. To use the second option, comment the first and uncomment the second.
Select one or more cells and then run the macro; typically though Alt+F8 then Run from the worksheet.
I am trying to create an automatic procedure which will be activated every time a user changes the values in a cell on a worksheet. I have managed to create a procedure that will record the value if one cell is changed, but if the user pastes in several cells then only the first cell which they selected will be changed. This is what I have so far, any guidance would be appreciated.
Option Explicit
Dim OldCellValue As String
' Get Windows Username
Function Usernam() As String
Usernam = Environ("username")
End Function
' Record the current cell value.
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
OldCellValue = ActiveCell.Text
End Sub
'Paste the original value and new value into the next free row on sheet3
'with Windows username, date and time
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Lstrow As Long
Dim Changerow As Long
Lstrow = Sheets("Sheet3").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0).Row
Sheets("Sheet3").Range("A" & Lstrow).Value = Usernam
Sheets("Sheet3").Range("B" & Lstrow).Value = Date
Sheets("Sheet3").Range("C" & Lstrow).Value = Time
Sheets("Sheet3").Range("D" & Lstrow).Value = "Sheet " & ActiveSheet.Name & _
", Range " & Target.Address & " Chanaged from """ & OldCellValue & _
""" to """ & Target.Value & """"
End Sub
Update
This shows you how to use the Target range with multiple cells but it doesn't address the need you now have to potentially store a multiple prior cell range in memory
I have played with
public variables to hold the prior range,
then process the cells if the address of the Selection Target is identical to the Change Target but it is very kludgy
I think you need a different way to track the change - for example on the Selection add the current value to a cell comment. Still messy though, and any cell by cell changes will be very intensive for Excel if working with ranges ...
Original Post
You need to work with the Target range to work on each cell,ie
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng1 As Range
Dim rng2 As Range
Set rng1 = Sheets("Sheet3").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
For Each rng2 In Target
rng1.Resize(1, 4) = Array(Environ("username"), Date, Time, "Sheet " & ActiveSheet.Name & _
", Range " & rng2.Address & " Changed from """ & OldCellValue & _
""" to """ & rng2.Value & """")
Next rng2
End Sub
I need to extract 1st letter from cell B2 concatenate with cell C2 paste in cell A2,
then move to next row and repeat till last data row.
I have the following, which partially works, but only works for the first row A2 then fills down this one string through all the rows till last data row.
Sub UserName()
Dim rng As range
Dim lastRow As Long
With Sheets("sheet1")
lastRow = .range("E" & .Rows.Count).End(xlUp).Row
End With
For Each rng In Sheets("Sheet1").range("A2:A" & lastRow)
rng.Value = fUserName(rng.Value)
Next
End Sub
The function
Function fUserName(ByVal strUserName As String) As String
Dim r As String
r = range("B2").Select
strUserName = Left(Trim(r), 1) & " " & range("C2")
fUserName = strUserName
End Function
IMHO you don't need VBA for that. Just use formula in A2
=CONCATENATE(LEFT(B2, 1),C2)
And then just replicate it for all cells that contain data.
Try below code. I have combined both your procedure.
No need of using a function , No need of For each loop
Sub UserName()
Dim lastRow As Long
With Sheets("sheet1")
lastRow = .Range("C" & .Rows.Count).End(xlUp).Row
End With
Range("A1:A" & lastRow).FormulaR1C1 = "= left(RC[1],1) & RC[2]"
End Sub
Your function is wrong, you are passing strUserName to the function but then setting the same variable within the function, however the real source of your issue is that you are using static references in your function so it does not matter which cell your sub routine is dealing with the function looks a cells B2 and C2.
I would get rid of the function all together and just replace the line
rng.Value = fUserName(rng.Value)
With
rng.Value = Left(Trim(rng.offset(0,1)), 1) & " " & rng.offset(0,2)
If you really want to use a function you need to pass the range to the function, not the value of the active cell as this has no bearing on the values of the other cells around it.
You need to pass the range into the function:
Sub UserName()
Dim rng As range
Dim lastRow As Long
With Sheets("sheet1")
lastRow = .range("E" & .Rows.Count).End(xlUp).Row
End With
For Each rng In Sheets("Sheet1").range("A2:A" & lastRow)
rng.Value = fUserName(rng)
Next
End Sub
Function fUserName(rn as Range) As String
fUserName = Left(Trim(rn(1,2).value), 1) & " " & rn(1,3).value
End Function
Well obviously B2 and C2 are hardcoded values so they do not change. You need to make those change by using a range object, for instance. Here's a pseudo-code of what I would do. I leave it up to you to make the necessary adjustments to make it work (because I don't see much effort in your question).
Function fUserName(rng as Range) as String
fUserName = Left(Trim(rng.Offset(0, 1).value), 1) & " " & rng.Offset(0, 2).value
End Function
Instead of calling fUserName() with rng.value, just put in rng. This will use the range object to get the proper rows for B and C.
Following code select first blank row
Sub SelFrstBlankRow()
Dim r1 As Range, r2 As Range, r3 As Range
Set r1 = Sheets("Sheet1").Range("a20")
Set r2 = Sheets("Sheet1").Range("u20")
Set r3 = Range(r1.End(xlUp), r2.End(xlUp)) 'r3 is the 1st blank row
r3.Select
End Sub
I need to find out the first cell and the last cell of a vertically merged cell..
Let's say I merge Cells B2 down to B50.
How can I get in VBA the start cell(=B2) and the end cell(=B50)?
Sub MergedAreaStartAndEnd()
Dim rng As Range
Dim rngStart As Range
Dim rngEnd As Range
Set rng = Range("B2")
If rng.MergeCells Then
Set rng = rng.MergeArea
Set rngStart = rng.Cells(1, 1)
Set rngEnd = rng.Cells(rng.Rows.Count, rng.Columns.Count)
MsgBox "First Cell " & rngStart.Address & vbNewLine & "Last Cell " & rngEnd.Address
Else
MsgBox "Not merged area"
End If
End Sub
Below macro goes through all sheets in a workbook and finds merged cells, unmerge them and put original value to all merged cells.
This is frequently needed for DB applications, so I wanted to share with you.
Sub BirlesenHucreleriAyirDegerleriGeriYaz()
Dim Hucre As Range
Dim Aralik
Dim icerik
Dim mySheet As Worksheet
For Each mySheet In Worksheets
mySheet.Activate
MsgBox mySheet.Name & “ yapılacak…”
For Each Hucre In mySheet.UsedRange
If Hucre.MergeCells Then
Hucre.Orientation = xlHorizontal
Aralik = Hucre.MergeArea.Address
icerik = Hucre
Hucre.MergeCells = False
Range(Aralik) = icerik
End If
Next
MsgBox mySheet.Name & " Bitti!!"
Next mySheet
End Sub
Suppose you merged B2 down to B50.
Then, start cell address will be:
MsgBox Range("B2").MergeArea.Cells(1, 1).Address
End cell address will be:
With Range("B2").MergeArea
MsgBox .Cells(.Rows.Count, .Columns.Count).Address
End With
You can put address of any cell of merged area in place of B2 in above code.
Well, assuming you know the address of one of the cells in the merged range, you could just select the offset from that range and get the row/column:
Sub GetMergedRows()
Range("A7").Select 'this assumes you know at least one cell in a merged range.
ActiveCell.Offset(-1, 0).Select
iStartRow = ActiveCell.Row + 1
Range("A7").Select
ActiveCell.Offset(1, 0).Select
iEndRow = ActiveCell.Row - 1
MsgBox iStartRow & ":" & iEndRow
End Sub
The code above will throw errors if the offset row cannot be selected (i.e. if the merged rows are A1 through whatever) so you will want to add error handling that tells the code if it can't offset up, the top rows must be 1 and if it can't go down, the bottom row must be 65,536. This code is also just one dimensional so you might want to add the x-axis as well.
If you want the cell references as strings, you can use something like this, where Location, StartCell, and EndCell are string variables.
Location = Selection.Address(False, False)
Colon = InStr(Location, ":")
If Colon <> 0 Then
StartCell = Left(Location, Colon - 1)
EndCell = Mid(Location, Colon + 1)
End If
If you want to set them as ranges, you could add this, where StartRange and EndRange are Range objects.
set StartRange = Range(StartCell)
set EndRange = Range (EndCell)
If you intend to loop through the merged cells, try this.
Sub LoopThroughMergedArea()
Dim rng As Range, c As Range
Set rng = [F5]
For Each c In rng.MergeArea
'Your code goes here
Debug.Print c.Address'<-Sample code
Next c
End Sub