I am new to VBA.
For each cell in columns("c:c")
If cell.value = "TRUE" Then
'vba is required for selecting corresponding cells in columns A and B
Next cell
Else:
exit sub
End if
end sub
please make suitable corrections
Try this one:
Sub test()
Dim lastrow As Long
Dim c As Range, rng As Range
'change Sheet1 to suit
With ThisWorkbook.Worksheets("Sheet1")
lastrow = .Cells(.Rows.Count, "C").End(xlUp).Row
For Each c In .Range("C1:C" & lastrow)
If UCase(c.Text) = "FALSE" Then
If rng Is Nothing Then
Set rng = .Range("A" & c.Row).Resize(, 2)
Else
Set rng = Union(rng, .Range("A" & c.Row).Resize(, 2))
End If
End If
Next c
End With
If Not rng Is Nothing Then rng.Select
End Sub
Related
I want to select only cells that contains data in specific range (C7:I15). Code below can do that only for column "G". How to change code for my range?
Sub Testa()
Dim LR As Long, cell As Range, rng As Range
With Sheets("Sheet1")
LR = .Range("G" & Rows.Count).End(xlUp).Row
For Each cell In .Range("G2:G" & LR)
If cell.Value <> "" Then
If rng Is Nothing Then
Set rng = cell
Else
Set rng = Union(rng, cell)
End If
End If
Next cell
rng.Select
End With
End Sub
You can use a generic function to which you pass the range that should be checked - and which returns a range with the non-empty cells (see update below for function using SpecialCells instead of iteration)
Public Function rgCellsWithContent(rgToCheck As Range) As Range
Dim cell As Range
For Each cell In rgToCheck
If cell.Value <> "" Then
If rgCellsWithContent Is Nothing Then
Set rgCellsWithContent = cell
Else
Set rgCellsWithContent = Union(rgCellsWithContent, cell)
End If
End If
Next cell
End Function
You can use this sub like this:
Sub Testa()
With ThisWorkbook.Worksheets("Sheet1")
'select cells in range C7:I15
rgCellsWithContent(.Range("C7:I15")).Select
'select cells in column G
Dim LR As Long
LR = .Range("G" & Rows.Count).End(xlUp).Row
rgCellsWithContent(.Range("G2:G" & LR)).Select
'you can even combine both
Dim rgNew As Range
Set rgNew = rgCellsWithContent(.Range("C7:I15"))
Set rgNew = Union(rgNew, rgCellsWithContent(.Range("G2:G" & LR)))
rgNew.Select
End With
End Sub
UPDATE:
This function uses the SpecialCells command.
You can make a difference to return values only or to return values and formulas.
Public Function rgCellsWithContent(rgToCheck As Range, _
Optional fValuesAndFormulas As Boolean = True) As Range
Dim cell As Range
On Error Resume Next 'in case there are no cells
With rgToCheck
Set rgCellsWithContent = .SpecialCells(xlCellTypeConstants)
If fValuesAndFormulas Then
Set rgCellsWithContent = Union(rgCellsWithContent, .SpecialCells(xlCellTypeFormulas))
End If
End With
On Error GoTo 0
End Function
If no formulas in the range where selection should be done, you can use the next compact code, not needing any iteration:
Dim rng As Range
On Error Resume Next 'for the case of no any empty cell
Set rng = Range("C7:I15").SpecialCells(xlCellTypeConstants)
On Error GoTo 0
If Not rng Is Nothing Then rng.Select
The next version is able to deal with formulas, too:
Dim rng As Range, rngSel As Range, arrFormula
Set rng = Range("C7:I15")
With rng
arrFormula = .Formula
.Value = .Value
On Error Resume Next
Set rngSel = .SpecialCells(xlCellTypeConstants)
On Error GoTo 0
.Formula = arrFormula
End With
If Not rngSel Is Nothing Then rngSel.Select
Need your help to get same objective to fill up the "null" value faster than below script .
Sub FillEmptyCell()
Dim rng As Range
Dim i As Long
Dim cell As Range
Dim sht As Worksheet
Set sht = ActiveWorkbook.Sheets("rawdata")
sht.Activate
Set rng = Range(Range("G2:G14614"), Range("G" & sht.UsedRange.Rows.Count))
For Each cell In rng
If cell.Value = "" Then cell.Value = "BLANKON"
Next
End Sub
Try,
Sub FillEmptyCell()
with workSheets("rawdata")
with .range(.cells(2, "G"), .cells(.rows.count, "G").end(xlup))
on error resume next
.specialcells(xlcelltypeblanks) = "BLANKON"
on error goto 0
end with
.Activate
end with
End Sub
I'm using a button macro to copy a range, it's super simple:
Worksheets("SNOW").Range("C6:D18").Copy
Now, how would I modify this to say "Copy this range, but if the value in column D is blank, skip that row completely in the copy process"? Dealing with text, not numbers.
Thanks.
You'll have to use Union to create a range that contains only your select rows (if the value in column D is not blank):
Sub Test()
Dim rng As Range, i As Long
For i = 6 To 18
If Range("D" & i).Value <> "" Then
If rng Is Nothing Then
Set rng = Range("C" & i & ":D" & i)
Else
Set rng = Application.Union(rng, Range("C" & i & ":D" & i))
End If
End If
Next i
If Not rng Is Nothing Then
rng.Copy
End If
End Sub
You could filter and copy the filtered data:
Sub Copy_Filtered()
With ThisWorkbook.Worksheets("Snow")
If .FilterMode Then
.ShowAllData
End If
With .Range("A6:D18")
.AutoFilter Field:=4, Criteria1:="<>"
.Copy 'Destination:=ThisWorkbook.Worksheets("Blizzard").Range("A1")
End With
End With
End Sub
NB: Uncomment the Destination to paste the range to the Blizzard sheet.
You can copy each area separately.
Option Explicit
Sub foo()
Dim ws As Worksheet, r As Range, rCpy As Range
Dim rDest As Range
Set ws = Worksheets("SNOW")
With ws
Set r = .Range(.Cells(6, 4), .Cells(18, 4)).SpecialCells(xlCellTypeConstants)
Set rDest = .Cells(6, 10)
For Each rCpy In r.Areas
Set rCpy = rCpy.Offset(columnoffset:=-1).Resize(columnsize:=2)
rCpy.Copy rDest
Set rDest = rDest.Offset(rCpy.Rows.Count)
Next rCpy
End With
End Sub
Another method, which will work no matter what the contents of the source data:
Set ws = Worksheets("SNOW")
With ws
.Rows.Hidden = False
Set rDest = .Cells(1, 6)
Set r = .Range(.Cells(6, 4), .Cells(18, 4)).SpecialCells(xlCellTypeBlanks)
r.EntireRow.Hidden = True
Set r = .Range(.Cells(6, 3), .Cells(18, 4)).SpecialCells(xlCellTypeVisible)
.Rows.Hidden = False
r.Copy rDest
End With
How to delete the values which are not followed by second immediate cell?
Following might help.
Sub Demo()
Dim ws As Worksheet
Dim lastRow As Long
Dim cel As Range
Set ws = ThisWorkbook.Sheets("Sheet5") 'change Sheet5 to your data sheet
With ws
lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
For Each cel In .Range("B1:B" & lastRow)
If IsEmpty(cel) Then 'or use If Len(cel) = 0 Then
cel.Offset(0, -1).ClearContents
End If
Next cel
End With
End Sub
If you want to delete the rows where Column B is empty then try this
Sub Demo()
Dim ws As Worksheet
Set ws = ThisWorkbook.Sheets("Sheet5") 'change Sheet5 to your data sheet
ws.Range("B1:B100").SpecialCells(xlCellTypeBlanks).EntireRow.Delete 'change range as per your data
End Sub
Use this macro. Enter it in regular module (eq Module 1). it will remove all values in column A in case there is no value in adjacent cell in column B.
Sub delete()
For x = 1 To Cells(Rows.Count, "A").End(xlUp).Row
If Range("B" & x).Value <> "" Then
Else
Range("A" & x).ClearContents
End If
Next x
End Sub
or if you want to delete those rows.
Sub deleteRows()
For x = Cells(Rows.Count, "A").End(xlUp).Row To 1 Step -1
If Range("B" & x).Value <> "" Then
Else
Range("A" & x).EntireRow.delete
End If
Next x
End Sub
Sub FillEmptyCell()
Dim rng As Range
Dim i As Long
Dim cell As Range
Dim sht As Worksheet
Set sht = ActiveWorkbook.Sheets("Sheet1")
sht.Activate
Set rng = Range(Range("C12"), Range("AD" & sht.UsedRange.Rows.Count))
For Each cell In rng
If cell.Value = "" Then
cell.Value = "0"
End If
Next
End Sub
I am trying to fill my blank spaces in sheet with zero dynamically.However,
I don't want this to fill zeroes in row that have no data. can someone help please?
See how this works,
Sub ZeroStuff()
Dim LstRw As Long, rng As Range, sh As Worksheet, c As Range
Set sh = Sheets("Sheet1")
With sh
LstRw = .Cells(.Rows.Count, "C").End(xlUp).Row + 1
Set rng = .Range("C12:C" & LstRw).SpecialCells(xlCellTypeBlanks)
For Each c In rng.Cells
.Range(c.Offset(, 1), c.Offset(, 27)) = 0
Next c
End With
End Sub