I am trying to add a blank row if the cell values under column C is "Confirm". Is this possible?
I want the macro to add blank rows below until the last active row of the sheet if it finds "Confirm" under column C.
regards,
Arjun T A
Option Explicit
Sub blankAfterConfirm()
Dim rng As Range, fnd As Range, addr As String
With Worksheets("sheet3").Range("C:C")
Set rng = .Find(what:="confirm", After:=.Cells(1), MatchCase:=False, _
LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, SearchFormat:=False)
If Not rng Is Nothing Then
addr = rng.Address(0, 0)
Set fnd = rng
Do
Set fnd = Union(fnd, rng)
Set rng = .FindNext(After:=rng)
Loop Until addr = rng.Address(0, 0)
fnd.Offset(1, 0).EntireRow.Insert
End If
End With
End Sub
Edited.
Dim x As Long, lRow As Long
lRow = Sheet1.Cells(Rows.Count, 3).End(xlUp).Row
For x = lRow To 2 Step -1
If Cells(x, 3).Value = "Confirm" Then
With Cells(x, 3).Offset(1).EntireRow
.Insert Shift:=xlDown
.ClearFormats
End With
End If
Next x
Related
I want to loop or find multiple value in another sheets. My code doesn't work even after I do..loop the code.
For i = 1 To lastrowBAU
Worksheets(fname).Range("A1:A" & lastrowsheet).Select
Do Until Cell Is Nothing
Set Cell = Selection.find(What:=ThisWorkbook.Worksheets("BAU").Range("A" & i).Value, After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, _
MatchCase:=False)
If Not Cell Is Nothing Then
Cell.Activate
ActiveCell.Copy
ActiveCell.Insert Shift:=xlShiftDown
ActiveCell.Offset(1, 0).Select
Selection.Replace What:=ThisWorkbook.Worksheets("BAU").Range("A" & i).Value, _
replacement:=ThisWorkbook.Worksheets("BAU").Range("B" & i).Value, _
LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False
Set Cell = Worksheets(fname).Range("A1:A" & lastrowsheet).FindNext(Cell)
End If
Loop
Next i
You need to set the cell before entering the loop
Set cell = rngSrc.Find(sA, LookIn:=xlFormulas, LookAt:=xlPart, _
After:=rngSrc.Cells(rngSrc.Cells.Count), SearchOrder:=xlByRows, MatchCase:=False)
If Not cell Is Nothing Then
however you also need to avoid an endless loop by checking if the search has returned to the first one found.
Option Explicit
Sub macro1()
Dim ws As Worksheet, wsBAU As Worksheet
Dim cell As Range, rngSrc As Range
Dim fname As String, lastrow As Long, lastrowBAU As Long
Dim i As Long, n As Long, first As String
Dim sA As String, sB As String
fname = "Sheet1"
With ThisWorkbook
Set ws = .Sheets(fname)
Set wsBAU = .Sheets("BAU")
End With
With ws
lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
Set rngSrc = .Range("A1:A" & lastrow)
End With
With wsBAU
lastrowBAU = .Cells(.Rows.Count, "A").End(xlUp).Row
End With
With ws
lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
Set rngSrc = .Range("A1:A" & lastrow)
End With
' search and replace
Application.ScreenUpdating = False
For i = 1 To lastrowBAU
sA = wsBAU.Cells(i, "A")
sB = wsBAU.Cells(i, "B")
Set cell = rngSrc.Find(sA, LookIn:=xlFormulas, LookAt:=xlPart, _
After:=rngSrc.Cells(rngSrc.Cells.Count), SearchOrder:=xlByRows, MatchCase:=False)
If Not cell Is Nothing Then
first = cell.Address
Do
' insert cell above
cell.Insert xlDown
cell.Offset(-1).Value2 = cell.Value2
cell.Value2 = Replace(cell.Value2, sA, sB)
' expand search range
n = n + 1
Set rngSrc = ws.Range("A1:A" & lastrow + n)
' find next
Set cell = rngSrc.FindNext(cell)
Loop While cell.Address <> first
End If
Next
Application.ScreenUpdating = True
MsgBox n & " replacements", vbInformation
End Sub
I am trying to select a range until the last used row in the sheet. I currently have the following:
Sub Select_Active_Down()
Dim lr As Long
lr = ActiveSheet.UsedRange.Rows.Count
If Cells(ActiveCell.Row, ActiveCell.Column) = Cells(lr, ActiveCell.Column) Then
MsgBox "There isn't any data to select."
Else
Range(Cells(ActiveCell.Row, ActiveCell.Column), Cells(lr, ActiveCell.Column)).Select
Cells(lr, ActiveCell.Column).Activate
End If
End Sub
The issue is that I need to select multiple columns, and this will only select the first column of the active range. How can I modify this to select multiple columns rather than just the first?
What about selection the entire region? This can be done as follows in VBA:
Selection.CurrentRegion.Select
There also is the possibility to select the entire array. For that, just press Ctrl+G, choose Special and see over there.
I would do this slightly different. I would use .Find to find the last row and the last column (using the same logic shown in the link) to construct my range rather than using Selection | Select | ActiveCell | UsedRange | ActiveSheet.
Is this what you are trying?
Option Explicit
Sub Sample()
Dim ws As Worksheet
Dim LastRow As Long
Dim LastColumn As Long
Dim rng As Range
'~~> Change it to the relevant sheet
Set ws = Sheet1
With ws
'~~> Check if there is data
If Application.WorksheetFunction.CountA(.Cells) = 0 Then
MsgBox "No Data Found"
Exit Sub
End If
'~~> Find last row
LastRow = .Cells.Find(What:="*", _
After:=.Range("A1"), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
'~~> Find last column
LastColumn = .Cells.Find(What:="*", _
After:=.Range("A1"), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Column
'~~> Construct your range
Set rng = .Range(.Cells(1, 1), .Cells(LastRow, LastColumn))
'~~> Work with the range
With rng
MsgBox .Address
'
'~~> Do what you want with the range here
'
End With
End With
End Sub
I am trying to add new data to excel sheet via UserForm but it's doesn't write continuously. just replace value of range E2 and its rows.
Note:If data already exist then update its relevant columns or write
new data to next empty row.
my code is below.
Option Explicit
Private Sub cmdAdd_Click()
Dim FindValue As String, Rng As Range
Dim iRow As Long, ws2 As Worksheet
Set ws2 = Worksheets("ITEM NAMES")
iRow = ws2.Cells(Rows.Count, 2).End(xlUp).Row + 1
FindValue = TextItemName
If Trim(FindValue) <> "" Then
With ws2.Range("E:E")
Set Rng = .Find(What:=FindValue, _
After:=.Cells(1), _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False)
If Not Rng Is Nothing Then
Rng.Offset(0, 1) = TextHSNCode.Value
Else
ws2.Cells(iRow, 5).Value = TextItemName.Value
ws2.Cells(iRow, 6).Value = TextHSNCode.Value
End If
End With
End If
End Sub
I am trying to loop through the first occurrence of a cell up to some unknown last nonempty cell. For example.
I know how to find the last and first nonempty cell but how can I put
them in a loop?
With Worksheets("AssignedTickets").Columns("F")
Set test = .Find(what:="*", after:=.Cells(1, 1), LookIn:=xlValues)
End With
Here is a couple of techniques:
Sub LoopThroughCells()
Dim c As Range, Target As Range, rFirst As Range, rLast As Range
Dim x As Long, y As Long
With Worksheets("Sheet1").Cells
Set rLast = .Find(What:="*", _
After:=.Cells(1), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False)
Set rFirst = .Find(What:="*", _
After:=rLast, _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
With .Range(rFirst, rLast)
Debug.Print "For Each c In .Cells"
For Each c In .Cells
If x <> c.Row Then Debug.Print
x = c.Row
Debug.Print c.Value,
Next
Stop
Debug.Print
Debug.Print "For x = 1 To .Rows.Count"
For x = 1 To .Rows.Count
Debug.Print
For y = 1 To .Columns.Count
Debug.Print .Cells(x, y),
Next
Next
End With
End With
End Sub
Note: A For Each Loop to iterates over a range row by row (e.g. All cells in Rows(1) then all the cells in Rows(2) ..etc.).
UPDATE:
Selecting the range starting from the first used cell and last used cell; without using find.
With Worksheets("Sheet1")
With .Range(.Range("C1").End(xlDown), .Range("C" & Rows.Count).End(xlUp))
For Each c In .Cells
If x <> c.Row Then Debug.Print
x = c.Row
Debug.Print c.Value,
Next
End With
End With
I am trying to select columns based on their heading value and then move them over to the end on the right. I know it is selecting the columns correctly, and identifying the next empty column. However, when running the code, it'll get down to the emptyRange.select.offset and then gives an error saying an object is required.
I'm not sure if I am overcomplicating this code.
Sub colShift()
Dim dCol As Range
Dim qCol As Range
Dim emptyRange As Range
With Sheets("Data")
Set dCol = Range( _
Range("A1:ZZ1").Find(What:="name_a", After:=.Cells(1, 1), LookIn:=xlValues, LookAt:= _
xlWhole, MatchCase:=False), _
Range("A1:ZZ1").Find(What:="name_a", After:=.Cells(1, 1), LookIn:=xlValues, LookAt:= _
xlWhole, MatchCase:=False).End(xlDown))
Set qCol = Range( _
Range("A1:ZZ1").Find(What:="name_b", After:=.Cells(1, 1), LookIn:=xlValues, LookAt:= _
xlWhole, MatchCase:=False), _
Range("A1:ZZ1").Find(What:="name_b", After:=.Cells(1, 1), LookIn:=xlValues, LookAt:= _
xlWhole, MatchCase:=False).End(xlDown))
End With
For Each cell In Range("A1:ZZ1")
cell.Activate
If IsEmpty(cell) = True Then
Set emptyRange = ActiveCell
Exit For
End If
Next cell
dCol.Select
Selection.Cut
emptyRange.Select.Offset
Selection.Insert Shift:=xlToRight
For Each cell In Range("A1:ZZ1")
cell.Activate
If IsEmpty(cell) = True Then
Set emptyRange = ActiveCell
Exit For
End If
Next cell
qCol.Select
Selection.Cut
emptyRange.Select
Selection.Insert Shift:=xlToRight
End Sub
Sloppy solution below
Sub colShift()
Dim dCol As Range
Dim qCol As Range
Dim emptyRange As Range
Dim MyRange As Range
Dim iCounter As Long
With Sheets("Data")
Set dCol = Range( _
Range("A1:ZZ1").Find(What:="name_a", After:=.Cells(1, 1), LookIn:=xlValues, LookAt:= _
xlWhole, MatchCase:=False), _
Range("A1:ZZ1").Find(What:="name_a", After:=.Cells(1, 1), LookIn:=xlValues, LookAt:= _
xlWhole, MatchCase:=False).End(xlDown))
Set qCol = Range( _
Range("A1:ZZ1").Find(What:="name_b", After:=.Cells(1, 1), LookIn:=xlValues, LookAt:= _
xlWhole, MatchCase:=False), _
Range("A1:ZZ1").Find(What:="name_b", After:=.Cells(1, 1), LookIn:=xlValues, LookAt:= _
xlWhole, MatchCase:=False).End(xlDown))
End With
For Each cell In Range("A1:ZZ1")
cell.Activate
If IsEmpty(cell) = True Then
Set emptyRange = ActiveCell
col = ActiveCell.Column
Exit For
End If
Next cell
dCol.Select
Selection.Cut
Cells(1, col).Select
ActiveSheet.Paste
'Blank Column Deleter
Set MyRange = ActiveSheet.UsedRange
For iCounter = MyRange.Columns.Count To 1 Step -1
If Application.CountA(Columns(iCounter).EntireColumn) = 0 Then
Columns(iCounter).Delete
End If
Next iCounter
'
For Each cell In Range("A1:ZZ1")
cell.Activate
If IsEmpty(cell) = True Then
Set emptyRange = ActiveCell
col = ActiveCell.Column
Exit For
End If
Next cell
qCol.Select
Selection.Cut
Cells(1, col).Select
ActiveSheet.Paste
'Blank Column Deleter
Set MyRange = ActiveSheet.UsedRange
For iCounter = MyRange.Columns.Count To 1 Step -1
If Application.CountA(Columns(iCounter).EntireColumn) = 0 Then
Columns(iCounter).Delete
End If
Next iCounter
End Sub
Couple of problems I see.
1) You are not checking if emptyRange is allocated with an object reference before trying to access it. Now, your worksheet might never have a data width that exceeds column "ZZ", but that is not good practice. That could be your problem, but it might not be - I wouldn't be able to tell without seeing your data.
2) I don't see what you are trying to do there with Offset. You haven't specified an argument for rows up/down or columns left/right so it's really not doing anything. Also, I don't think you can use it after a select statement like that. If you wanted to do that you would do:
emptyRange.Select
Selection.Offset(0,1) `this would offset one column - not sure what you wanted to do
But that whole selection step is unnecessary as you can work with the object directly:
emptyRange.Offset(0,1)
As to whether or not you're overcomplicating things: yes - you can simplify this code quite a bit by getting rid of all the Activate & Select methods and just working with the objects directly.
Instead of looping over all the cells in A1:ZZ1, just use the Find method again. The other benefit of this, is that using find as I've done below will always return an object (in excel 2007 and up) so you won't need a check like I mentioned above.
I don't particularly like the use of two find statements to create a range of used data for dCol and qCol - I found it difficult to read and interpret what you were doing. Here again I wouldn't use a fixed sized range as I mentioned above - this makes your code more fragile. I actually think it's a lot easier to read and understand if you break this into two operations: 1) find the column, 2) resize the range down to the last row in the column
You can avoid a second loop by using Offset to just move over one column, and you can eliminate the insert line by providing the destination argument for cut.
EDIT after OP posted "sloppy solution":
You can greatly simplify the code by just selecting the entire column and inserting it before the last empty column. You then don't need any routine to cleanup blank columns.
Sub colShift()
Dim dCol As Range
Dim qCol As Range
Dim destination As Range
With Sheets("Data").Cells
'Find the cell in row 1 which contains "name_a"
Set dCol = .Find(What:="name_a", After:=.Cells(1, 1), LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByColumns, MatchCase:=False).EntireColumn
'Repeat same steps for qCol
Set qCol = .Find(What:="name_b", After:=.Cells(1, 1), LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByColumns, MatchCase:=False).EntireColumn
'Find the last column which has data in it, and get the next column over (the first empty column)
Set destination = .Find("*", .Cells(1, 1), xlFormulas, xlPart, xlByColumns, xlPrevious).Offset(0, 1).EntireColumn
End With
'Insert dCol before the first empty column at the end of the data range:
dCol.Cut
destination.Insert shift:=xlShiftToRight
'Insert qCol before that same empty column
qCol.Cut
destination.Insert shift:=xlShiftToRight
End Sub