I need help creating a macro that will clear contents of a selected row but only from columns A to J, I can clear the entire row but that is not very useful as I have multiple tables on that row.
Please Help
Thank You!
Application.Intersect(Selection.EntireRow, Selection.Worksheet.Columns("A:J")).ClearContents
One row:
Option Explicit
Sub test()
Dim RowNo As Long
With ThisWorkbook.Worksheets("Sheet1") '<- Change sheet name if needed
RowNo = Selection.Row '<- Get row number
.Range("A" & RowNo & ":J" & RowNo).ClearContents '<- Clear range A to J of the selected line
End With
End Sub
Multiple rows:
Option Explicit
Sub test()
Dim rng As Range
With ThisWorkbook.Worksheets("Sheet1") '<- Change sheet name if needed
For Each rng In Selection.Rows
.Range("A" & rng.Row & ":J" & rng.Row).ClearContents
Next
End With
End Sub
You can run over every cell in your selectin, and clear its contents:
Sub test()
Dim R As Range
For Each R In Selection:
If R.Column <= 10 Then
R.ClearContents
End If
Next
End Sub
The Column being smaller than 10 means being somewhere from column A to J.
Related
I've been trying to find a solution for that problem but nothing came up.
Here is the problem I've got. I would like to copy a variable data range from a sheet called ("Amounts") starting in range "C3" to an other sheet called ("Pasted Amounts") in range F2 as many time as columns, in sheets "Amounts" are starting with the following value " Amounts in USD".
I've been coding something but it doesn't work... I put a counter in a cell to count how many time there are columns starting with the value " Amounts in USD" in order to pick the value appearing in that cell and repeat the paste process. But I've been complicated the code I guess...
Here is my code;
Dim cel2 As Range
Dim counter as Integer
With Sheets("Amounts")
Worksheets("Amounts").Activate
For Each cel2 In Range("A2", Range("A2").End(xlToRight))
If cel2.Value Like "Amount in USD*" Then
counter = counter + 1
Range("U4").Value = counter
End If
With Worksheets("Pasted Amounts").Activate
'~Here is bellow the column named " clients name" I want to paste in "Pasted amounts" sheet (by coping it in the sheet "Amounts"
worksheets("Amounts").Range("C3",range("C3").end(xldown).Select
'~ Paste the range copied in sheet " Pasted Amount" as many time the counter value is
.Copy Range("F2").Resize(.Count * counter)
End With
Next cel2
End With
End sub
Once again, I'd appreciate so much your help...
Mido88
Sub test()
Dim LastColumn As Long, LastRow As Long, counter as Long
With Sheets("Amounts")
LastColumn = .Cells(1, .Columns.Count).End(xlToLeft).Column
LastRow = .Cells(.Rows.Count, "C").End(xlUp).Row
counter = WorksheetFunction.CountIf(.Range("A1", .Cells(1, LastColumn)), "Amount in USD*")
.Range("C3:C" & LastRow).Copy _
Worksheets("Pasted Amounts").Range("F2").Resize(.Range("C3:C" & LastRow).Count * counter)
End With
End Sub
Or as a silly long one line of code:
Sub test()
Sheets("Amounts").Range("C3:C" & Sheets("Amounts").Cells(Sheets("Amounts").Rows.Count, "C").End(xlUp).Row).Copy Worksheets("Pasted Amounts").Range("F2").Resize(Sheets("Amounts").Range("C3:C" & Sheets("Amounts").Cells(Sheets("Amounts").Rows.Count, "C").End(xlUp).Row).Count * WorksheetFunction.CountIf(Sheets("Amounts").Range("A1", Sheets("Amounts").Cells(1, Sheets("Amounts").Cells(1, Sheets("Amounts").Columns.Count).End(xlToLeft).Column)), "Amount in USD*"))
End Sub
Alright I found the solution!
Thank you again Siddharth and Christofer, your answers helped me a lot to think further...
Here is the solution that worked really well! I used the answer in the previous post I made here:link and added a single line code to paste as many time the range of datas as" Amounts in USD " was found in the previous sheet.
Sorry again for those misunderstandings. I hope that my answer would help you and the other users in need!
Here it is;
Sub Sample()
Dim wsInput As Worksheet
Dim wsOutput As Worksheet
Dim lRowInput As Long
Dim lRowOutput As Long
Dim lCol As Long
Dim i As Long
Dim Col As String
'~~> Set your sheets here
Set wsInput = Sheets("Amounts")
Set wsOutput = Sheets("Pasted Amounts")
With wsInput
'~~> Find last column in Row 2
lCol = .Cells(2, .Columns.Count).End(xlToLeft).Column
'~~> Loop through columns
For i = 1 To lCol
'~~> Check for your criteria
If .Cells(2, i).Value2 Like "Amount in functional currency*" Then
'~~> Get column name
Col = Split(.Cells(, i).Address, "$")(1)
'~~> Get the last row in that column
lRowInput = .Range(Col & .Rows.Count).End(xlUp).Row
'~~> Find the next row to write to
If lRowOutput = 0 Then
lRowOutput = 2
Else
lRowOutput = wsOutput.Range("A" & wsOutput.Rows.Count).End(xlUp).Row + 1
End If
'~~> Copy the datas ( for each column where Amounts in USD was found)
.Range(Col & "3:" & Col & lRowInput).Copy _
wsOutput.Range("A" & lRowOutput)
~~> SOLUTION BELLOW-Copy the variable data range ("C3")
Worksheets("Amounts").Activate
.Range("C3", Range("C3").End(xlDown)).Copy wsOutput.Range("F" & lRowOutput)
End If
Next i
End With
End Sub
Mido
I'm a beginner. Just learning by Googleing, but cannot find a solution for this. Please help.
I want to run the below macro.
I have multiple cells named "CV_=CVCAL" in the same column.
What I want is for the macro to find the first cell with the value "CV_=CVCAL" and offset to the adjacent cell. If the adjacent cell has a particular value, if the value is below lets say "1.5" i want to fill it will a cell style 'bad'.
I want the macro to go through all the cells that have the name CV_=CVCAL and do the same thing until there is no more cells named CV_=CVCAL.
Sub If_CV()
Range("A1").Select
Set FoundItem = Range("C1:C1000").Find("CV_=CVCAL")
FoundItem.Offset(columnOffset:=1).Select
If ActiveCell.Value >= 1.5 Then
ActiveCell.Style = "Bad"
End If
End Sub
Sounds like you want to loop through your values.
Determine the end of your range
Loop through your range and check your criteria
Sub If_CV()
Dim ws As Worksheet: Set ws = ThisWorkbook.Sheets("Sheet1")
Dim lr As Long, i As Long
lr = ws.Range("C" & ws.Rows.Count).End(xlUp).Row
For i = 2 To lr
If ws.Range("C" & i) = "CV_=CVCAL" Then
If ws.Range("D" & i) >= 1.5 Then
ws.Range("D" & i) = "Bad"
End If
End If
Next i
End Sub
A basic loop would be simpler:
Sub If_CV()
Dim c As Range, ws As Worksheet
For Each ws in ActiveWorkbook.Worksheets
For Each c in ws.Range("C1:C1000").Cells
If c.Value = "CV_=CVCAL" Then
With c.offset(0, 1)
If .Value >= 1.5 Then .Style = "Bad"
End With
End If
Next ws
Next c
End Sub
in the range A1 to A70, if a cell is empty/blank then delete that entire row and move the other rows underneath up
Thank you
Use following codes.
Sub RemoveDuplicate()
On Error Resume Next
Range("A1:A70").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End Sub
Edit:
Sub RemoveBlankRowsInARange()
Dim rng As Range, rws As Long, i As Long
Dim LastRow As Long
' LastRow = Cells(Rows.Count, "A").End(xlUp).Row
' Set rng = ActiveSheet.Range("A2:A" & LastRow)
' rws = rng.Rows.Count
'
' For i = rws To 1 Step (-1)
For i = 100 To 1 Step (-1)
If WorksheetFunction.CountA(Rows(i)) = 0 Then Rows(i).EntireRow.Delete
Next
End Sub
#Harun24HR - Here's how I attempted at solving this problem: I recorded a macro that deletes a row and I edited that macro to do my original question, why doesn't this work, please correct it:
Sub DeleteRowWithEmptyCell()
Dim row As Integer
For row = 1 To 100 'or whatever numbers needed
If Cells(row, 1).Value() = "" Then
Rows("row:row").Select
Selection.Delete Shift:=xlUp
End If
Next row
End Sub
I have the sheet like this:
Picture given
All I want to is that, I can move down the next row and show its value.
I already have the code:
Sub test()
'Select the first row.
MsgBox Sheet1.AutoFilter.Range.Offset(1).SpecialCells(xlCellTypeVisible).Cells(1, 3).Value
'Then move down to the second row of filtered data.
'Code
End Sub
Can someone suggest how to finish my sub above?
I would appreciate your help.
You could try implement/adapt the following:
Sub VisRows()
Dim rng As Range, lr As Long
With Sheet1 'Change accordingly
lr = .Cells(.Rows.Count, "B").End(xlUp).Row
Set rng = .Range("B2:B" & lr)
'Apply your filter
For Each cl In rng.SpecialCells(xlCellTypeVisible)
Debug.Print cl.Value
Next cl
End With
End Sub
Sub SelectAllReleventText()
Do While Range(“A1”).Offset(1, 6) <> Empty
Rows(ActiveCell.Row).Select
ActiveCell.Offset(1, 0).Select
Loop
End Sub
Here is my script, I've been told it doesn't do what it is meant to, which I expected since this was my first attempt. I am coming up with a variable not defined error. I thought I defined the variable, but I guess it wasn't specific enough for Excel VBA.
This is what I am attempting to do.
In Workbook 1, On B6 there is an alphanumeric name, I want that row to be selected.
Go down one row, if there is text there select that row.
Continue till text is no longer prevalent.
Copy selected rows.
Paste into another workbook (Workbook2), into tab 1, starting on row 2, since row 1 has headers.
Thanks in advance. Just a heads up, I am using the Options Explicit in my VBA because I was told it was the "right way to do thing"...
Yes using Option Explicit is a good habit. Using .Select however is not :) it reduces the speed of the code. Also fully justify sheet names else the code will always run for the Activesheet which might not be what you actually wanted.
Is this what you are trying?
Option Explicit
Sub Sample()
Dim lastRow As Long, i As Long
Dim CopyRange As Range
'~~> Change Sheet1 to relevant sheet name
With Sheets("Sheet1")
lastRow = .Range("A" & .Rows.Count).End(xlUp).Row
For i = 2 To lastRow
If Len(Trim(.Range("A" & i).Value)) <> 0 Then
If CopyRange Is Nothing Then
Set CopyRange = .Rows(i)
Else
Set CopyRange = Union(CopyRange, .Rows(i))
End If
Else
Exit For
End If
Next
If Not CopyRange Is Nothing Then
'~~> Change Sheet2 to relevant sheet name
CopyRange.Copy Sheets("Sheet2").Rows(1)
End If
End With
End Sub
NOTE
If if you have data from Row 2 till Row 10 and row 11 is blank and then you have data again from Row 12 then the above code will only copy data from Row 2 till Row 10
If you want to copy all rows which have data then use this code.
Option Explicit
Sub Sample()
Dim lastRow As Long, i As Long
Dim CopyRange As Range
'~~> Change Sheet1 to relevant sheet name
With Sheets("Sheet1")
lastRow = .Range("A" & .Rows.Count).End(xlUp).Row
For i = 2 To lastRow
If Len(Trim(.Range("A" & i).Value)) <> 0 Then
If CopyRange Is Nothing Then
Set CopyRange = .Rows(i)
Else
Set CopyRange = Union(CopyRange, .Rows(i))
End If
End If
Next
If Not CopyRange Is Nothing Then
'~~> Change Sheet2 to relevant sheet name
CopyRange.Copy Sheets("Sheet2").Rows(1)
End If
End With
End Sub
Hope this is what you wanted?
Sid
The easiest way to do it is to use the End method, which is gives you the cell that you reach by pressing the end key and then a direction when you're on a cell (in this case B6). This won't give you what you expect if B6 or B7 is empty, though.
Dim start_cell As Range
Set start_cell = Range("[Workbook1.xlsx]Sheet1!B6")
Range(start_cell, start_cell.End(xlDown)).Copy Range("[Workbook2.xlsx]Sheet1!A2")
If you can't use End, then you would have to use a loop.
Dim start_cell As Range, end_cell As Range
Set start_cell = Range("[Workbook1.xlsx]Sheet1!B6")
Set end_cell = start_cell
Do Until IsEmpty(end_cell.Offset(1, 0))
Set end_cell = end_cell.Offset(1, 0)
Loop
Range(start_cell, end_cell).Copy Range("[Workbook2.xlsx]Sheet1!A2")