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
Related
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
I have a question about saving the rownumber and then filling data with it in the next for loop like below. However, when I run this, it runs the code to find the LastRow again which then does not exist anymore as it's empty.
Sub kolomE()
Dim i, j As Integer
Dim LastRow As Long
With ActiveSheet
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
End With
Range("E3:E3" & LastRow).ClearContents
Range("E3:E3" & LastRow) = "&omegaOne="
End Sub
So I want it to fill the cells it cleared with .ClearContents to fill it with "&omegaOne="
You forgot to erase row number from your ranges. It should be:
Range("E3:E" & LastRow).ClearContents
Range("E3:E" & LastRow).Value = "&omegaOne="
I have searched a bit for a VBA code that will list me a row reference and am not finding results. Perhaps I am missing what the actual term for it is?
I have a list of names in Column A, starting at A2. Then what I would like is a listing of 1,2,3,4,5 going down Column B, starting from B2, until the names stop.
I can do this as a formula but need to have the values set there by a macro in this case.
Can this be done?
If I understand you correctly then this should work:
Sub test()
Dim lastRow As Long, counter As Long
Dim cell As Range
Dim ws As Worksheet
Set ws = ThisWorkbook.Worksheets("NAME_OF_YOUR_WORKSHEET")
lastRow = ws.Range("A" & ws.Rows.Count).End(xlUp).Row
counter = 1
For Each cell In ws.Range("B2:B" & lastRow)
cell.Value = counter
counter = counter + 1
Next cell
End Sub
No need for a loop:
Sub NumberRows()
With Sheets("Sheet Name Here")
With .Range("B2:B" & .Cells(.Rows.Count, 1).End(xlUp).Row)
.Formula = "=ROW()-1"
.Value = .Value
End With
End With
End Sub
I am attempting to do a simple copy row, paste row within a workbook. I've searched threads and tried changing my code multiple times to no avail.
The one that comes closest to working is this but it only copies a single instance of matching criteria.
I am trying to create a loop that will copy all of the rows that has a match in one of the columns.
So, if 8 columns, each row with matching value in column 7 should copy to a named sheet.
Sub test()
Set MR = Sheets("Main").Range("H1:H1000")
Dim WOLastRow As Long, Iter As Long
For Each cell In MR
If cell.Value = "X" Then
cell.EntireRow.Copy
Sheets("X").Range("A" & Rows.Count).End(xlUp).PasteSpecial
End If
If cell.Value = "Y" Then
cell.EntireRow.Copy
Sheets("Y").Range("A" & Rows.Count).End(xlUp).PasteSpecial
End If
If cell.Value = "Z" Then
cell.EntireRow.Copy
Sheets("Z").Range("A" & Rows.Count).End(xlUp).PasteSpecial
End If
If cell.Value = "AB" Then
cell.EntireRow.Copy
Sheets("AB").Range("A" & Rows.Count).End(xlUp).PasteSpecial
End If
Application.CutCopyMode = False
Next
End Sub
I like this because I need to target multiple destination sheets with different criteria but I need all rows that match criteria to copy over.
EDITED CODE IN RESPONSE TO NEW REQUEST:
The code below will copy all of the rows in Sheet Main and paste them into the corresponding worksheets based on the value in Column 7.
Do note: If there is a value in Column 7 that does NOT match to an existing sheet name, the code will throw an error. Modify the code to handle that exception.
Let me know of any additional needed help.
Sub CopyStuff()
Dim wsMain As Worksheet
Dim wsPaste As Worksheet
Dim rngCopy As Range
Dim nLastRow As Long
Dim nPasteRow As Long
Dim rngCell As Range
Dim ws As Worksheet
Const COLUMN_TO_LOOP As Integer = 7
Application.ScreenUpdating = False
Set wsMain = Worksheets("Main")
nLastRow = wsMain.Cells(Rows.Count, 1).End(xlUp).Row
Set rngCopy = wsMain.Range("A2:H" & nLastRow)
For Each ws In ActiveWorkbook.Worksheets
If UCase(ws.Name) = "MAIN" Then
'Do Nothing for now
Else
Intersect(ws.UsedRange, ws.Columns("A:H")).ClearContents
End If
Next ws
For Each rngCell In Intersect(rngCopy, Columns(COLUMN_TO_LOOP))
On Error Resume Next
Set wsPaste = Worksheets(rngCell.Value)
On Error GoTo 0
If wsPaste Is Nothing Then
MsgBox ("Sheet name: " & rngCell.Value & " does not exist")
Else
nPasteRow = wsPaste.Cells(Rows.Count, 1).End(xlUp).Row + 1
wsMain.Range("A" & rngCell.Row).Resize(, 8).Copy wsPaste.Cells(nPasteRow, 1)
End If
Set wsPaste = Nothing
Next rngCell
Application.ScreenUpdating = True
End Sub
Your current code is pasting to the same row in each sheet over and over, to the last row with a value in column A. Range("A" & Rows.Count).End(xlUp) says, roughly "go to the very bottom of the spreadsheet in column A, and then jump up from there to the next lowest cell in column A with contents," which gets you back to the same cell each time.
Instead, you could use lines of the pattern:
Sheets("X").Range("A" & Sheets("X").UsedRange.Rows.Count + 1).PasteSpecial
Where UsedRange is a range containing all of the cells on the sheet with data in them. The + 1 puts you on the following row.
You could make this a little prettier using With:
With Sheets("X")
.Range("A" & .UsedRange.Rows.Count + 1).PasteSpecial
End With
I am trying to use a macro to clean up data files and only copy on Sheet2 what is most relevant.
I have written the code to find the row I want the data to be copied from. However I can only copy the row itself and not the range underneath. Please note I need the range to go from that row to the last column and last row as the size of the matriz always varies.
s N s N s N s N s rpm
Linear Real Linear Real Linear Real Linear Real Linear Amplitude
0.0000030 9853.66 0.0000030 5951.83 0.0000030 533.48 0.0000030 476.15 0.0000030 2150.16
0.0000226 9848.63 0.0000226 5948.19 0.0000226 557.02 0.0000226 488.60 0.0000226 2150.16
0.0000421 9826.05 0.0000421 5956.22 0.0000421 615.94 0.0000421 480.75 0.0000421 2150.15
0.0000616 9829.72 0.0000616 5989.72 0.0000616 642.59 0.0000616 476.77 0.0000616 2150.15
So basically the code below finds that first row and copies it in Sheet2. I need the macro to also select the range underneath and copy it onto Sheet2. Please can you help me finishing off the script?
Sub SearchForRawData()
Dim LSearchRow As Integer
Dim LCopyToRow As Integer
On Error GoTo Err_Execute
'Start search in row 1
LSearchRow = 1
'Start copying data to row 2 in Sheet2 (row counter variable)
LCopyToRow = 2
While Len(Range("A" & CStr(LSearchRow)).Value) >= 0
'If value in column A = "s", copy entire row to Sheet2
If Range("A" & CStr(LSearchRow)).Value = "s" Then
'Select row and range in Sheet1 to copy
Rows(CStr(LSearchRow) & ":" & CStr(LSearchRow)).Select
Selection.Copy
'Paste row into Sheet2 in next row
Sheets("Sheet2").Select
Rows(CStr(LCopyToRow) & ":" & CStr(LCopyToRow)).Select
ActiveSheet.Paste
'Select all Raw Data underneath found Row to Copy
'Paste all Raw Data into Sheet 2
'Move counter to next row
LCopyToRow = LCopyToRow + 1
'Go back to Sheet1 to continue searching
Sheets("Sheet1").Select
End If
LSearchRow = LSearchRow + 1
Wend
'Position on cell A1
Application.CutCopyMode = False
Range("A1").Select
MsgBox "All matching data has been copied."
Exit Sub
Err_Execute:
MsgBox "An error has occured"
End Sub
You don't need a loop for this if you want to copy the row that has the "s" and everything below it to the target sheet. The following sub finds the row with the "s" in column A and then copies that row and everything below it to the target sheet.
Note that you should always avoid selecting or activating anything in VBA code, and that the normal way to copy and paste relies on selecting. If you use the syntax I've included here, the clipboard is not used and the target sheet does not need to be selected.
Sub CopyRowAndBelowToTarget()
Dim wb As Workbook
Dim src As Worksheet
Dim tgt As Worksheet
Dim match As Range
Set wb = ThisWorkbook
Set src = wb.Sheets("Sheet1")
Set tgt = wb.Sheets("Sheet2")
Dim lastCopyRow As Long
Dim lastPasteRow As Long
Dim lastCol As Long
Dim matchRow As Long
Dim findMe As String
' specify what we're searching for
findMe = "s"
' find our search string in column A (1)
Set match = src.Columns(1).Find(What:=findMe, After:=src.Cells(1, 1), _
LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
' figure out what row our search string is on
matchRow = match.Row
' get the last row and column with data so we know how much to copy
lastCopyRow = src.Range("A" & src.Rows.Count).End(xlUp).Row
lastCol = src.Cells(1, src.Columns.Count).End(xlToLeft).Column
' find out where on our target sheet we should paste the results
lastPasteRow = tgt.Range("A" & src.Rows.Count).End(xlUp).Row
' use copy/paste syntax that doesn't use the clipboard
' and doesn't select or activate
src.Range(Cells(matchRow, 1), Cells(lastCopyRow, lastCol)).Copy _
tgt.Range("A" & lastPasteRow)
End Sub
Rows(CStr(LSearchRow) & ":" & CStr(LSearchRow)).Select
So firstly you don't acutally need the CStr, vba will cast numbers to strings by itself, i.e. Range(LSearchRow & ":" & LSearchRow) should work fine.
To find how many rows down to go use the end function of the range object:
bottomRow = Range("A" & LSearchRow).End(xldown).Row
Do the same for the column
lastCol = Range("A" & LSearchRow).End(xlleft).column
Now to copy:
Range("A" & LSearchRow & ":" & lastCol & bottomRow).Copy
However if you have empty cells inthe middleof the data then instead of using End(xldown), start at the bottom of the sheet and look up:
bottomRow = Range("A1000000").End(xlup).Row
etc