I am trying to move the cell value to adjacent cell if the string contains # character in it. but the following Macro is not working as intended.
Sub Macro1()
Dim MatchString As String
MatchString = "#"
For Counter = 1 To Range("A:A").Count
If (InStr(Range("A" & Counter).Value, Len(MatchString)) = MatchString) Then
Range("A" & Counter).Select
Selection.Cut
Range("B" & Counter).Select
ActiveSheet.Paste
End If
Next Counter
End Sub
Kindly suggest me what I missed in this macro so that my program works well.
This should work; using Like
Sub Macro1()
With ActiveSheet
For Counter = 1 To .Range("A:A").Count
If .Range("A" & Counter).Value Like "*#*" Then
.Range("A" & Counter).Cut .Range("B" & Counter)
Application.CutCopyMode = False
End If
Next Counter
End With
End Sub
You should avoid selecting/activating in VBA:
How to avoid using Select in Excel VBA macros
If you don't really want to loop over an entire column read this:
EXCEL VBA - Loop through cells in a column, if not empty, print cell value into another column
As posted as another answer, Find would be a good approach (faster) toward this problem.
Rather then looking at every cell in column A just go straight to the cells with FIND.
Each time # is found it will be moved to column B and the value in column A is removed. When there's no more to find the loop will stop.
Public Sub MoveToAdjactent()
Dim MatchString As String
Dim rFound As Range
MatchString = "#"
With ThisWorkbook.Worksheets("Sheet1").Columns(1)
Set rFound = .Find(MatchString, LookIn:=xlValues, LookAt:=xlPart)
If Not rFound Is Nothing Then
Do
rFound.Offset(, 1) = rFound
rFound.ClearContents
Set rFound = .FindNext(rFound)
Loop While Not rFound Is Nothing
End If
End With
End Sub
Related
I'm trying to write a macro that removes rows with the condition that the string in the cells in column A contains "--" or "-4" or "" (empty). I'd do it with a normal filter, but that gives me max 2 conditions.
Sub Delete_Rows()
Dim cell As Range
For Each cell In Range("A:A")
If cell.Value = "*--*" Or cell.Value = "*-4*" Then
cell.EntireRow.Delete
End If
Next cell
End Sub
What am I doing wrong?
Please, test the next version. It uses an array for iteration and a Union range to delete rows at once, at the end of the code:
Sub Delete_Rows3Cond()
Dim sh As Worksheet, lastR As Long, rngDel As Range, arr, i As Long
Set sh = ActiveSheet
lastR = sh.Range("A" & sh.rows.count).End(xlUp).row
arr = sh.Range("A1:A" & lastR).Value2 'place the range in an array for faster iteration/processing only in memory
For i = 1 To UBound(arr)
If arr(i, 1) = "" Or arr(i, 1) Like "*--*" Or arr(i, 1) Like "*-4*" Then
addToRange rngDel, sh.Range("A" & i) 'create the union range
End If
Next
If Not rngDel Is Nothing Then rngDel.EntireRow.Delete xlUp
End Sub
Private Sub addToRange(rngU As Range, Rng As Range) 'I creates the Union range
If rngU Is Nothing Then
Set rngU = Rng
Else
Set rngU = Union(rngU, Rng)
End If
End Sub
Deleting a row at a time, takes a lot of time and you need to process only the range containing data...
Please, send some feedback after testing it.
= checks for identical strings, so unless you have a cell containing "*--*" or "*-4*", the If-clause will never be true. You will have to use the like-operator:
If cell.Value like "*--*" Or cell.Value like "*-4*" Then
Two remarks:
Your code will loop through the whole Excel sheet (which contains 1'048'576 rows) so that will run a very long time. And, even worse, if you add the check for empty cells to delete a row, it will delete one million rows and it would look as if Excel/VBA is frozen. Therefore you need to figure out the last row before you run the code. More on this at Find last used cell in Excel VBA
And you need to be aware the that code will run on the active sheet - the sheet that currently has the focus. You should always specify the sheet (and workbook) where you want to code to work with. Don't go down the path to Select the sheet to make if active. For more details, see How to avoid using Select in Excel VBA
Sub Delete_Rows()
Dim cell As Range, lastRow As Long
' Replace the following line with the workbook you want to work with
With ThisWorkbook.Sheets(1)
lastRow = .Cells(.Rows.Count, "A").End(xlUp).row
For Each cell In .Range("A1:A" & lastRow)
If cell.Value Like "*--*" Or cell.Value Like "*-4*" Then
cell.EntireRow.Delete
End If
Next cell
End With
End Sub
You can use the Like operator instead of "=" to perform the comparison. Consider the following the code:
Sub Delete_Rows()
Dim cell As Range
For Each cell In Range("A:A")
If cell.Value Like "*--*" Or cell.Value Like "*-4*" Then
cell.EntireRow.Delete
End If
Next cell
End Sub
You can also read more about the like operator here for example: https://www.wallstreetmojo.com/vba-like/
I hope this helps :D
I am working on a macro that will search an entire workbook for various codes. These codes are all six digit numbers. Codes I wish to search for are input in column A of a sheet called "Master". If a code found on another sheet matches one in Master it's sheet name and cell will be pasted in column B next to it's match in Master. When successful the end result looks like this.
The code posted below works in certain cases, but fails quite often. Occasionally a run-time error will appear, or an error message with "400" and nothing else. When these errors occur the macro fills a row with matches for a blank value at the end of all the listed codes. This is obviously not an intended function.
I am at a loss regarding the above error. I have wondered if limiting the search range would help stability. All codes on other sheets are only found in column A, so searching for matches in all columns as is done currently is quite wasteful. Speed is secondary to stability however, I first want to eliminate all points of failure.
Sub MasterFill()
Dim rngCell As Range
Dim rngCellLoc As Range
Dim ws As Worksheet
Dim lngLstRow As Long
Dim lngLstCol As Long
Dim strSearch As String
Sheets("Master").Select
lngLstRowLoc = Sheets("Master").UsedRange.Rows.Count
Application.ScreenUpdating = False
For Each rngCellLoc In Range("A1:A" & lngLstRowLoc)
i = 1
For Each ws In Worksheets
If ws.Name = "Master" Then GoTo SkipMe
lngLstRow = ws.UsedRange.Rows.Count
lngLstCol = ws.UsedRange.Columns.Count
ws.Select
For Each rngCell In Range(Cells(2, 1), Cells(lngLstRow, lngLstCol))
If InStr(rngCell.Value, rngCellLoc) > 0 Then
If rngCellLoc.Offset(0, i).Value = "" Then
rngCellLoc.Offset(0, i).Value = ws.Name & " " & rngCell.Address
i = i + 1
End If
End If
Next
SkipMe:
Next ws
Next
Application.ScreenUpdating = True
Worksheets("Master").Activate
MsgBox "All done!"
End Sub
See if this doesn't expedite matters while correcting the logic.
Sub MasterFill()
Dim addr As String, fndCell As Range
Dim rngCellLoc As Range
Dim ws As Worksheet
Application.ScreenUpdating = False
With Worksheets("Master")
For Each rngCellLoc In .Range(.Cells(1, "A"), .Cells(.Rows.Count, "A").End(xlUp))
For Each ws In Worksheets
If LCase(ws.Name) <> "master" Then
With ws.Columns("A")
Set fndCell = .Find(what:=rngCellLoc.Value2, After:=.Cells(1), _
LookIn:=xlFormulas, LookAt:=xlPart, _
MatchCase:=False, SearchFormat:=False)
If Not fndCell Is Nothing Then
addr = fndCell.Address(0, 0)
Do
With rngCellLoc
.Cells(1, .Parent.Columns.Count).End(xlToLeft).Offset(0, 1) = _
Join(Array(ws.Name, fndCell.Address(0, 0)), Chr(32))
End With
Set fndCell = .FindNext(After:=fndCell)
Loop While addr <> fndCell.Address(0, 0)
End If
End With
End If
Next ws
Next
.Activate
End With
Application.ScreenUpdating = True
MsgBox "All done!"
End Sub
I've used LookAt:=xlPart in keeping with your use of InStr for criteria logic; if you are only interested in whole cell values change this to LookAt:=xlWhole.
I've restricted the search range to column A in each worksheet.
Previous results are not cleared before adding new results.
Your own error was due to the behavior where a zero length string (blank or vbNullString) is found within any other string when determined by Instr.
I just want to know how to loop through the non blank cells on Column A. What I'm trying to do is copy the contents on [A1:B1] to be added on top of each non blank cells on Column A. So far I have counted the non blank cells on column A but I'm stuck. I know that an Offset function should be used for this.
Here's my code so far:
Dim NonBlank as Long
NonBlank = WorksheetFunction.CountA(Worksheet(1).[A:A])
For i = 1 to NonBlank
[A1:B1].Copy Offset(1,0). "I'm stuck here"
Next i
If you are trying to fill the headers for each Product, try this...
Sub FillHeaders()
Dim lr As Long
Dim Rng As Range
lr = ActiveSheet.UsedRange.Rows.Count
Application.ScreenUpdating = False
On Error Resume Next
Range("A1:B1").Copy
For Each Rng In Range("A3:A" & lr).SpecialCells(xlCellTypeConstants, 2).Areas
If Rng.Cells(1).Value <> Range("A1").Value Then
Rng.Cells(1).Offset(-1, 0).PasteSpecial xlPasteAll
End If
Next Rng
Application.CutCopyMode = 0
Application.ScreenUpdating = True
End Sub
As example to simulate the effect of Ctrl-Down from Cell A1 and display the Address, Value in the Immediate Window:
Sub HopToNextNonBlankCellBelow()
Dim oRng As Range
Set oRng = Range("A1")
Debug.Print "Cell Address", "Cell Value"
Do
Set oRng = oRng.End(xlDown)
If Not IsEmpty(oRng) Then Debug.Print oRng.Address(0, 0), oRng.Value
Loop Until oRng.Row = Rows.Count
Set oRng = Nothing
End Sub
Try this... I've (probably) overcounted the rows at 1000, but it likely won't make a difference with your performance. If you wanted to be more precise, there are hundreds of articles on how to find the last row of a range. As for the Offset function, it references a cell in relation to the one we're looping through. In the example below, the code is saying cell.offset(0,1) which means one cell to the right of the cell we are currently looping through. A clearer (less loopy!) example would be if you typed: Range("A10").offset(0,1) it would be the same as typing Range("B10")
Dim Cell As Range
For Each Cell In Range("A2:A1000").Cells
If Not IsEmpty(Cell) Then
Cell.Offset(0, 1).Value = Cell.Value
End If
Next Cell
Sub Macro6()
Dim rngW As Range
Dim cell As Range
Set rngW = Range("W1", Range("W65536").End(xlUp))
For Each cell In rngW
If cell.Value = "Y" Then
Rows.Select
Range.Activate
Selection.Insert Shift:=xlDown
End Sub
I want to put add a blank row above each "Y" in column W that I find in my entire excel sheet. This will help me separate chunks of data. I keep getting "Compile Error: Argument not Optional". What gives?
As Scott Craner points out you are missing closing statements for If and Next.
Also, when inserting or deleting rows, you will need to loop backwards through the row set.
See code below:
Sub Macro6()
Dim lRow as Long
lRow = Range("W" & Rows.Count).End(xlUp).Row
Dim i as Long
For i = lRow to 1 Step -1
if Range("W" & i).Value = "Y" Then Range("W" & i).EntireRow.Insert Shift:=xlDown
Next
End Sub
I'm trying to run a simple For loop which will be expanded to include more functionality later but having trouble as it keeps throwing an error "invalid next control variable reference". The code I am trying to use is listed below.
Sub Tickbox()
Set Location = Sheets("TickBoxSheet").Range("B:B")
i = WorksheetFunction.CountA(Location)
Sheets("TickBoxSheet").Range("B2").Select
For a = 1 To i
If Selection.Value = "True" Then
Row = Selection.Row
'Hide some rows in another sheet via if statements
ActiveCell.Offset(1, 0).Select
End If
Next i
End Sub
I don't know if I need more coffee this morning but I can't seem to figure out what the hell is going on. Any help will be greatly appreciated.
The incremented variable (in Next) should be the index variable, i.e.:
For a = 1 To i
'...
Next a
i is so popular as index that you should think twice before using it in other contexts.
You have already got your answer from llmo. However there are few other things I would like to stress upon...
Try and avoid .Select. It will slow down your code.
Also It is not necessary that WorksheetFunction.CountA(Location) will give you the last row considering that you want to loop through all the rows which have data. I suggest this
Sub Tickbox()
Dim i As Long, a As Long, Rw As Long
With Sheets("TickBoxSheet")
i = .Range("B" & .Rows.Count).End(xlUp).row
For a = 2 To i
If .Range("B" & a).Value = "True" Then
Rw = a
'Hide some rows in another sheet via if statements
End If
Next a
End With
End Sub
You can make it more fast using Autofilter as well so that you loop through cells which only have True For example
Sub Tickbox()
Dim i As Long, a As Long, Rw As Long
Dim Location As Range, acell As Range
With Sheets("TickBoxSheet")
'~~> Remove any filters
.AutoFilterMode = False
i = .Range("B" & .Rows.Count).End(xlUp).row
With .Range("B1:B" & i)
.AutoFilter Field:=1, Criteria1:="True"
Set Location = .Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow
Debug.Print Location.Address
End With
'~~> Remove any filters
.AutoFilterMode = False
For Each acell In Location
If acell.Value = "TRUE" Then
Rw = acell.row
'Hide some rows in another sheet via if statements
End If
Next acell
End With
End Sub