I'm trying to clear the data before the keyword TRUE including blank cells in between, and also I don't want to hardcode the range because the range will keep on change. can anyone please help me with this.
A
1
2
3
4
5
3
4
53
53
TRUE
I hope it is what you need.
Option Explicit
Sub clr()
Dim ws As Worksheet
Set ws = Sheet1 'The sheet where the data are
Dim rng As Range
Set rng = ws.Range("A:A") 'Range where the data are
Dim rngFind As Range
Set rngFind = rng.Find("TRUE") 'Find TRUE
Dim rngClear As Range
Set rngClear = Range("A1", rngFind.Offset(-1)) 'Set the range to clear
rngClear.Clear
End Sub
I assume that cell containing value "True" as the last value in the column "A". If that is the case below code will clear the content of all the cells above to it.
Sub ClearCells()
Dim lastRow As Integer
Dim actSheet As Worksheet
Set actSheet = ThisWorkbook.ActiveSheet
With actSheet
lastRow = .Range("A" & .Rows.Count).End(xlUp).Row
.Range("A1:A" & lastRow - 1).Clear
End With
End Sub
Thanks,
KV Ramana
Related
I have a column with 7000+ names. I want to make each name's length not excess to 5. Here is what I have tried which doesn't work
Sub del()
Dim myCell
Set myCell = ActiveCell
Dim count As Integer
count = Len(ActiveCell)
While count > 5
myCell = Left(myCell, Len(myCell) - 1)
myCell.Offset(1, 0).Select
Set myCell = ActiveCell
Wend
End Sub
No need for VBA. You can use a formula, =Left(A1,5), to get the first 5 characters of the cell. Simply autofill the formula down.
If you still want VBA then also you do not need to loop. See this example. For explanation see Convert an entire range to uppercase without looping through all the cells
Option Explicit
Sub Sample()
Dim ws As Worksheet
Dim lRow As Long
Dim rng As Range
'~~> Change this to the relevant sheet
Set ws = ThisWorkbook.Sheets("Sheet1")
With ws
lRow = .Range("A" & .Rows.Count).End(xlUp).Row
Set rng = .Range("A1:A" & lRow)
rng = Evaluate("index(left(" & rng.Address(External:=True) & ",5),)")
End With
End Sub
In the above code I am assuming that the data is in column A in Sheet1. Change as applicable.
In Action
I have an old workbook with Conditional Formatting that has got out of hand in terms of random conditional formatting having evolved. I would like to loop through the sheet and delete all the conditional formatting that only refers to one cell (but preserve other formatting in the same cell and of course preserve the cell value etc.)
I have written the code in a separate sheet so that (1) I can re-use it and (2) the workbook itself doesn't need macros
So far, I can identify the cells but can't delete the formatting. The code I have is:
Option Explicit
Sub Delete_Conditional()
Dim fc As FormatCondition
Dim lLastRow As Long, lLastCol As Long
Dim rAllCells As Range, rCell As Range
Dim ws As Worksheet
Dim wb As Workbook
Set wb = Workbooks("Book1.xlsx")
Set ws = wb.Worksheets("Sheet1")
'Find last cell and set a range to cover all cells
lLastCol = ws.Cells(1, Columns.Count).End(xlToLeft).Column
lLastRow = ws.Cells(Rows.Count, 1).End(xlUp).Row
Set rAllCells = Range(Cells(1, 1), Cells(lLastRow, lLastCol))
'Loop through all cells
For Each rCell In rAllCells.Cells
'Loop through all FormatConditions in the cell
For Each fc In rCell.FormatConditions
'Determine if the FormatCondition only applies to one cell
If fc.AppliesTo.Cells.Count = 1 Then
Debug.Print fc.AppliesTo.Address
'I have tried fc.Delete
'I have tried fc.AppliesTo.Delete
End If
Next fc
Next rCell
End Sub
When I go back to the sheet, I can see the formatting still exists.
When deleting from a collection of items sometimes it works better if you work backwards:
Sub Delete_Conditional()
Dim fc As FormatCondition
Dim lLastRow As Long, lLastCol As Long
Dim rAllCells As Range, rCell As Range
Dim ws As Worksheet
Dim wb As Workbook, i As Long
Set wb = Workbooks("Book1.xlsx")
Set ws = wb.Worksheets("Sheet1")
'Find last cell and set a range to cover all cells
lLastCol = ws.Cells(1, Columns.Count).End(xlToLeft).Column
lLastRow = ws.Cells(Rows.Count, 1).End(xlUp).Row
Set rAllCells = Range(Cells(1, 1), Cells(lLastRow, lLastCol))
'Loop through all cells
For Each rCell In rAllCells.Cells
'Loop through all FormatConditions in the cell
For i = rCell.FormatConditions.Count To 1 Step -1
With rCell.FormatConditions(i)
If .AppliesTo.Cells.Count = 1 Then
Debug.Print .AppliesTo.Address
.Delete
End If
End With
Next i
Next rCell
End Sub
I'm trying to dynamically define a range in row like ctrl+down or ctrl+shift+down (to next blank cell) to be used with "For Each itm In rng" statement.
Originally I had it static like this set rng = Range("A4:A10")
So I tried to change it to something like this
Dim rng As Range
Set rng = Range("A4").CurrentRegion.Rows.Count
For Each itm In rng
...
Next itm
I also tried something like this
Set StartCell = Range("A4")
rng = sht.Cells(sht.Rows.Count, StartCell.Column).End(xlUp).Row
But the code doesn't seems to work with "For Each itm In rng" statement
Any help is very much appreciated.
You can use .xlDown, it's the equivalent of pressing ctrl+Shift+down.
Dim rng As Range
Dim lastRow As Long
lastRow = Range("A4").End(xlDown).Row
Set rng = Range("A4:A" & lastRow)
For Each itm In rng
'do something
Next itm
Try this if it helps:
Option Explicit
Sub Test()
Dim LastRow As Long 'to find the last row on your range
Dim MyRange As Range 'to reference the whole range
Dim C As Range 'to loop through your range
With ThisWorkbook.Sheets("MySheet") 'change MySheet for your sheet name
LastRow = .Cells(4, 1).End(xlDown).Row 'last row, how? You go down to the last row and then ctrl + up
Set MyRange = .Range("A4:A" & LastRow) 'dynamic range
For Each C In MyRange
'your code
Next C
End With
End Sub
I have two Excel files.
I am trying to do the following:
Search for a value in Sheet one.
When item is found use offset to pick up the adjacent value i.e. 4 columns to the left (same row)
Add the value (in step 2) to sheet two at the end of Row D
Struggling with the third step.
I get method or data member not found.
Sub findOne()
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Set ws1 = ThisWorkbook.Sheets("one") ' ref to sheet one
Set ws2 = ThisWorkbook.Sheets("two") ' ref to sheet two
Dim rng As Range
With ws1
' use find on range H
Set rng = Range("H1:H200").Find(What:="busaoc", LookAt:=xlPart)
'- doesn't like this
ws2.Range("D2").End(xlDown).Offset(1, 0) = ws1.rng(.Offset(0, -4))
End With
end Sub
You were not using your With block, but I removed it here since it doesn't seem necessary if this is your complete code. This has also been amended to not crash on the chance your value is actually not found.
Sub findOne()
Dim ws1 As Worksheet: Set ws1 = ThisWorkbook.Sheets("one")
Dim ws2 As Worksheet: Set ws2 = ThisWorkbook.Sheets("two")
Dim rng As Range, LR As Long
Set rng = ws1.Range("H1:H200").Find(What:="busaoc", LookAt:=xlPart)
If rng Is Nothing Then
MsgBox "Value not found"
Else
LR = ws2.Range("D" & ws2.Rows.Count).End(xlUp).Offset(1).Row
ws2.Range("D" & LR).Value = rng.Offset(0, -4).Value
End If
End Sub
I want to define a variable range in an Excel macro with VBA. The first cell is always A25, but the last cell is moving depending on the number of data collected. This can be E35, or E58, etc. Any idea how to do this?
There are 2 options:
Option 1: the Range you are looking to define is continuous (see screen-shot below):
the easy approach will do:
Option Explicit
Sub DefRange()
Dim Rng As Range
With Worksheets("Sheet1") '<-- modify "Sheet" to your sheet's name
Set Rng = .Range("A25").CurrentRegion
Debug.Print Rng.Address '<-- for debug: will show A25:E35
End With
End Sub
Option 2: the Range you are looking to define, has an empty line in the middle (screen-shot below):
then, the previous method will result with the wrong range
Option Explicit
Sub DefRange()
Dim Rng As Range
Dim LastRow As Long
Dim LastCol As Long
With Worksheets("Sheet1") '<-- modify "Sheet" to your sheet's name
Set Rng = .Range("A25").CurrentRegion
Debug.Print Rng.Address '<-- for debug: will show A25:E35 ***WRONG***
'Search for any entry, by searching backwards by Rows.
LastRow = .Cells.Find(What:="*", After:=.Range("A25"), SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
'Search for any entry, by searching backwards by Columns.
LastCol = .Cells.Find(What:="*", After:=.Range("A25"), SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
Set Rng = .Range(.Cells(25, "A"), .Cells(LastRow, LastCol))
Debug.Print Rng.Address '<-- for debug: will show A25:F37 ***CORRECT***
End With
End Sub
You can define a range as its two limit cells. Let's say you are working in the worksheet "ws":
Dim rng As Range
Dim cl1 As Range: Set cl1 = ws.Range("A25")
Dim cl2 As Range
Set cl2 = ws.Range("E35") 'Or something else'
Set rng = ws.Range(cl1, cl2)
Just count the rows in Column E,
Sub Button1_Click()
Dim LstRw As Long
Dim Rng As Range, x
LstRw = Cells(Rows.Count, "E").End(xlUp).Row
x = IIf(LstRw > 25, LstRw, 25)
Set Rng = Range("A25:E" & x)
Rng.Select
End Sub