I want that if cell in column e is not blank but cell in column i is blank then write unregister in column i or else write what ever written in column i.
Please help - I have used below code:
Sub Simple_If()
Dim lastrow As Long
lastrow = Cells(Rows.Count, "F").End(xlUp).Row
If Range("e2:e" & lastrow).Value <> "" And Range("i2:i" & lastrow).Value = "" Then
Range("i2:i" & lastrow).Value = "unregister"
End If
End Sub
The reason your code was not working is because you can't get .value of a .range (Range("e2:e" & lastrow).Value <> ""). Instead, use a for loop to iterate through each cells value individually.
I have commented each line of the code below to help you understand what is happening.
To make this work, change SO.xlsm to the name of your workbook and 63649177 to the name of your worksheet.
Sub Simple_If()
Dim WB As Workbook ' workbook - full name of the file containing data.
Dim WS As Worksheet ' worksheet - worksheet within workbook containing data.
Dim lRow As Long ' last row - find last row containing data
Dim i As Long ' iteration - used for loop
Set WB = Workbooks("SO.xlsm") ' set the name of the workbook here
Set WS = WB.Worksheets("63649177") ' set the name of the worksheet here
lRow = WS.Cells(WS.Rows.count, "E").End(xlUp).Row ' find the last row of E in the WS object, not user defined.
Set Rng = WS.Range("E2:E" & lRow) ' set the initial range
For i = 2 To lRow ' from line 2 to the last row, repeat this loop
If WS.Range("E" & i).Value <> "" And WS.Range("I" & i).Value = "" Then ' if E contains data and I does not then
WS.Range("I" & i).Value = "unregister" ' fill cell with "unregister"
End If ' end if
Next ' cycle through next iteration of loop
End Sub
Output
Loop Through Rows
You were trying to check the values of two ranges "E2:E & LastRow" and "I2:I & LastRow" in one go, but you cannot do that. You have to loop through the rows of the ranges and check each cell i.e. "E2", "E3", "E4" ... "E" & LastRow and "I2", "I3", "I4" ... "I" & LastRow. For this task a For Next loop can used.
The 1st code is showing how it is done using Range.
The 2nd code is showing how it is done using column strings (letters) with Cells.
The 3rd code is showing how it is done using column numbers with Cells.
The 4th code is showing how you can define the column ranges (rng1, rng2) and use Cells with one parameter.
The 5th code is showing how you can define constants to store the so called 'magic' characters and later quickly access (change) them. It is also modified to be able to change the resulting column (tgtCol).
Range might seem easier, but you have to learn Cells, too, e.g. because you cannot loop through columns using Range, you have to use column numbers with Cells.
Study the first three codes closely, and you will learn the differences soon enough.
The Code
Option Explicit
Sub fillSimpleRangeVersion()
' Calculate the last non-blank cell in column "F".
Dim LastRow As Long
LastRow = Range("F" & Rows.Count).End(xlUp).Row
Dim i As Long
' Loop through the rows from 2 to LastRow.
For i = 2 To LastRow ' i will change: "2, 3, 4 ... LastRow"
' Check that current cell in column "E" is not blank and
' that current cell in column "I" is blank:
' If not E2 blank and I2 blank then,
' If not E3 blank and I3 blank then ...
' If not E & LastRow blank and I & LastRow blank then.
If Not IsEmpty(Range("E" & i)) And IsEmpty(Range("I" & i)) Then
' If true, write "unregister" to current cell in column "I".
Range("I" & i).Value = "unregister"
' The Else statement is not needed, because you only write when
' the condition is true.
Else
' If not true, do nothing.
End If
Next i
End Sub
Sub fillSimpleCellsStringsVersion() ' Column Strings E, F, I
Dim LastRow As Long
LastRow = Cells(Rows.Count, "F").End(xlUp).Row
Dim i As Long
For i = 2 To LastRow
If Not IsEmpty(Cells(i, "E")) And IsEmpty(Cells(i, "I")) Then
Cells(i, "I").Value = "unregister"
End If
Next i
End Sub
Sub fillSimpleCellsNumbersVersion() ' Column Numbers 5, 6, 9
Dim LastRow As Long
LastRow = Cells(Rows.Count, 6).End(xlUp).Row
Dim i As Long
For i = 2 To LastRow
If Not IsEmpty(Cells(i, 5)) And IsEmpty(Cells(i, 9)) Then
Cells(i, 9).Value = "unregister"
End If
Next i
End Sub
Sub fillSimpleCellsVersionWithRanges()
Dim LastRow As Long
LastRow = Cells(Rows.Count, "F").End(xlUp).Row
Dim rng1 As Range
Set rng1 = Range("E2:E" & LastRow)
Dim rng2 As Range
Set rng2 = Range("I2:I" & LastRow)
Dim i As Long
For i = 1 To rng1.Rows.Count
If rng1.Cells(i).Value <> "" And rng2.Cells(i).Value = "" Then
rng2.Cells(i).Value = "unregister"
End If
Next i
End Sub
Sub fillSimpleCellsExpanded()
Const FirstRow As Long = 2 ' First Row
Const LastRowCol As Variant = "F" ' The column to Calculate Last Row
Const Col1 As Variant = "E" ' Column 1
Const Col2 As Variant = "I" ' Column 2
Const tgtCol As Variant = "I" ' Target Column, the Column to Write to
' You want to write to the same column "CritCol2 = tgtCol", but if you
' want to write to another column, you can easily change "tgtCol".
Const Criteria As String = "unregister" ' Write Criteria
Dim LastRow As Long
LastRow = Cells(Rows.Count, LastRowCol).End(xlUp).Row
Dim i As Long
For i = FirstRow To LastRow
If Not IsEmpty(Cells(i, Col1)) And IsEmpty(Cells(i, Col2)) Then
Cells(i, tgtCol).Value = Criteria
Else
' The following line is only needed if "CritCol2" is different
' than "tgtCol".
Cells(i, tgtCol).Value = Cells(i, Col2).Value
End If
Next i
End Sub
Related
Please help a newbie.
Using Excel VBA, I am trying to format the text in column A with hyphens but only if column B contains the letter B.
I have found the code below, one which formats the cells in column A with hyphens, and another code which checks column B for the correct value, but cannot seem to combine them to work. Help please.
Thank you.
Sub AddDashes()
Dim Cell As Range
On Error GoTo NoFilledCells
For Each Cell In Range("A1:A" & Cells(Rows.Count, "A").End(xlUp).Row).SpecialCells(xlCellTypeConstants)
Cell.Value = Format(Replace(Cell.Value, "-", ""), "#####-###-####")
Next
NoFilledCells:
End Sub
and
Sub ChangeColumn()
Dim LastRow As Long
Dim i As Long
LastRow = Range("A" & Rows.Count).End(xlUp).Row
For i = 2 To LastRow
If Range("B" & i).Value = "B" Then
Range("A" & i).Value = "Formatted text with hyphens as above"
End If
Next i
End Sub
Option Explicit
Sub AddDashes()
Dim ws As Worksheet, cell As Range
Dim LastRow As Long
Set ws = ActiveSheet
LastRow = ws.Range("A" & Rows.Count).End(xlUp).Row
For Each cell In ws.Range("A2:A" & LastRow)
If cell.Offset(0, 1) = "B" Then ' col B
cell.Value = Format(Replace(cell.Value, "-", ""), "#####-###-####")
End If
Next
End Sub
I'm looking for a way to autofill my formula down to the last row in the dataset (which is variable) using a range which is also variable. I have highlighted my issue below at the bottom.
Here is the code that I have now:
Sub MissingData()
Dim LastRow As Long
Dim LastCol As Long
Set ws = Worksheets("Insert Data")
With ws
Last Row = .Cells(.Rows.Count, 1).End(xlUp).Row
Last Col = .Cells(1, .Columns.Count).End(xlToLeft).Column
'Inserting Column Header next to the last column in the data set in row 1"
.Cells(1, LastCol + 1).Value = "Header"
'Inserting Formula next ot the last column in the data set in row 2"
.Cells(2, LastCol + 1).Formula = "=iferror(AJ2,""YES"")"
End With
Dim FoundCell As Range
'Looking for the Last Row in the Dataset"
'Column A:A will always be populated with data and will be the driver
'for how many rows are in the data set"
LR = Worksheets("Insert Data").Range("A:A").End(xlDown).Row
With ws
'I set this and then called it using select because my range above
'and the location of this cell could be variable"
Set FoundCell = .Cells(2, LastCol + 1)
FoundCell.Select
'Here lies my issue. Using this syntax the formula is filled all the way
'to the last row available in Excel which is like 1 million something.
'I just need it filled to the last now that i set above"
Selection.AutoFill Destination:=Range(ActiveCell, ActiveCell.End(xlDown))
End With
End Sub
A better alternative to AutoFill is to enter the formula in the entire range in one go. Is this what you are trying?
Option Explicit
Sub MissingData()
Dim LastRow As Long
Dim LastCol As Long
Dim ws As Worksheet
Dim LastColName As String
Set ws = Worksheets("Insert Data")
With ws
'~~> Find last row
LastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
'~~> Find last column and add 1 to it
LastCol = .Cells(1, .Columns.Count).End(xlToLeft).Column + 1
'~~> Get Column name from column number
' https://stackoverflow.com/questions/10106465/excel-column-number-from-column-name
LastColName = Split(.Cells(, LastCol).Address, "$")(1)
'~~> Add header
.Range(LastColName & 1).Value = "Header"
'~~> Add the formula in the entire range in ONE GO
' Example: Range("D2:D" & LastRow).Formula = "=IFERROR(AJ2,""YES"")"
.Range(LastColName & 2 & ":" & LastColName & LastRow).Formula = "=IFERROR(AJ2,""YES"")"
End With
End Sub
In my code, it identifies every value in the column A "This is a date format" and "This is not a date format". But i need it to copy the value from A:F in the row that it states "This is not a date format" and paste it in specific cell above it like. Offset(-1, 2). Also delete the row of the cell 'That is not a date format' after the value copied. Any ideas thanks. Below is my code:
Dim strDate As String
Dim rng As Range, cell As Range
Set rng = Range("A2:A18")
With ThisWorkbook.Worksheets("Feuil1")
For Each cell In rng
MsgBox (cell.Value)
strDate = cell.Value
If IsDate(strDate) Then
MsgBox "This is a date format"
Else
MsgBox "This is not a date format"
'copy cell from A:E
Range("A" & ActiveCell.Row & ":F" & ActiveCell.Row).Copy
'Paste selected and copied in specific cell in offset(Row, Column)
Range("K" & ActiveCell.Row).Offset(-1, 2).PasteSpecial
'copy cell from A:E
'Paste selected and copied in specific cell in offset(Row, Column)
End If
Next cell
End With
End Sub
Try the next code, please. It works for all the A:A range (with data). If you need only up to A18, change lastRow = 18:
Sub testCopyNotDate_DeleteRow()
Dim sh As Worksheet, strDate As String, rngDel As Range
Dim lastRow As Long, i As Long
Set sh = ThisWorkbook.Worksheets("Feuil1")
lastRow = sh.Range("A" & Rows.count).End(xlUp).Row
For i = 2 To lastRow
If Not IsDate(sh.Range("A" & i).Value) Then
sh.Range("A" & i & ":F" & i).Copy Destination:=sh.Range("A" & i).Offset(-1, 2)
If rngDel Is Nothing Then
Set rngDel = sh.Range("A" & i)
Else
Set rngDel = Union(rngDel, sh.Range("A" & i))
End If
End If
Next i
If Not rngDel Is Nothing Then rngDel.EntireRow.Delete xlUp
End Sub
It would be very fast (for big ranges) deleting the rows at once...
Try this basic code to loop from the last row to the first row, copy the row if the first cell is not a date, and paste the data to the row above the current row starting at column M; then delete the current row.
With ThisWorkbook.Sheets("Feuil1") 'Id your workbook and worksheet using a `With` statement
For x = 18 To 1 Step -1 'loop through your rows from the last to the first
'Check if the data in column A of the current row is not a date
If IsDate(Range("A" & x)) = False Then
'Copy the range from columns A:F on the current row and paste on the row above starting at column M
.Range("A" & x & ":F" & x).Copy .Range("M" & x - 1)
'Delete the current row
.Rows(x).Delete
End If
Next x 'Loop to the next row
End With
Copy And Delete
Option Explicit
Sub copyAndDelete()
Const wsName As String = "Feuil1"
Const FirstRow As Long = 2
Const LastRowCol As Variant = "A"
Const srcCol As Variant = "A"
Const tgtCol As Variant = "M"
Const NumOfCells As Long = 6
Const RowOff As Long = -1
Dim wb As Workbook: Set wb = ThisWorkbook
' Define worksheet.
Dim ws As Worksheet: Set ws = wb.Worksheets(wsName)
' Calculate Last Row (or not).
Dim LastRow As Long
' Either calculate LastRow (usually),
LastRow = ws.Cells(ws.Rows.Count, LastRowCol).End(xlUp).Row
' Or just use 18:
'LastRow = 18
' Check if there is any data.
If LastRow < FirstRow Then Exit Sub
' Calculate Column Offset.
Dim ColOff As Long
ColOff = ws.Columns(tgtCol).Column - ws.Columns(srcCol).Column
' Define Criteria Range.
Dim rng As Range: Set rng = ws.Range(ws.Cells(FirstRow, srcCol), _
ws.Cells(LastRow, srcCol))
' Loop through cells in Criteria Column.
Dim URng As Range, cell As Range, varDate As Variant
For Each cell In rng
varDate = cell.Value
If Not IsDate(varDate) Then
GoSub copyCells
GoSub collectCells
End If
Next cell
' Test with hidden.
If Not URng Is Nothing Then URng.EntireRow.Hidden = True
' When tested, outcomment the previous and uncomment the following line.
'If Not URng Is Nothing Then URng.EntireRow.Delete
Exit Sub
copyCells:
' Either (for values only)(faster):
cell.Offset(RowOff, ColOff).Resize(, NumOfCells).Value _
= cell.Resize(, NumOfCells).Value
' Or (including formats, formulas ...)(slower):
'cell.Resize(, NumOfCells).Copy _
cell.Offset(RowOff, ColOff).Resize(, NumOfCells)
Return
collectCells:
If Not URng Is Nothing Then
Set URng = Union(URng, cell)
Else
Set URng = cell
End If
Return
End Sub
I have a range of cells (dynamic number of rows) that I want to copy over starting with A1 cell. The below code isn't working for me as it is not moving the entire range of cell values from current location to A1. Please advise.
Range("E:E").Cut Range("A1")
Example,
If range in E is 50 rows, the cut and move should start at A1 and end at A50.
If range in E is 999 rows, the cut and move should start at A1 and end at A999.
As per your comment above, see below code:
Sub CutPaste()
Dim i As Long
Dim sRow As Long, eRow As Long
Dim ws As Worksheet
Set ws = Sheets("Sheet1")
'set the last row of data
eRow = ws.Range("E" & ws.Rows.Count).End(xlUp).Row
'find the start row of data
For i = 1 To eRow
If ws.Range("E" & i).Value <> "" Then
sRow = i
Exit For
End If
Next i
'now cut and paste
ws.Range("E" & sRow, "E" & eRow).Cut ws.Range("A1").Paste
'clear clipboard and object
Application.CutCopyMode = False
Set ws = Nothing
End Sub
This should work for you:
Sub Kopy()
Dim N As Long
N = Cells(Rows.Count, "E").End(xlUp).Row
Range("E1:E" & N).Cut Range("A1")
End Sub
NOTE:
You do not need to specify the same dimensions for the destination. A single cell will do.
Before:
and after:
I have this code to copy rows from a sheet to another if the condition is true, but I have a little problem. The cells of Sheet1 have formulas and I want to paste just the values to Sheet2.
How can I do this in this code?
Sub CopyRows()
Dim cell As Range
Dim lastRow As Long, i As Long
Dim FName As String
Dim FPath As String
Dim NewBook As Workbook
lastRow = Range("A" & Rows.Count).End(xlUp).Row
i = 1
For Each cell In Sheets("Sheet1").Range("T1:T" & lastRow)
If cell.Value = "X" Or cell.Value = "Y" Then
cell.EntireRow.Copy Sheets("Sheet2").Cells(i + 1, 1)
i = i + 1
End If
Next
End Sub
Replace this line:
cell.EntireRow.Copy Sheets("Sheet2").Cells(i + 1, 1)
With these two lines instead:
cell.EntireRow.Copy
Sheets("Sheet2").Cells(i + 1, 1).PasteSpecial xlPasteValues