i have created the following code, it aims at delete the empty cell in column R that exists between data, the problem comes to how to store the blank cell in range, any advise?
Sub Macro1()
Dim lastRow_1 As Long
Dim counter_1 As Long
Dim rng_1 As Range, aCell As Range
lastRow_1 = Range("R" & Rows.Count).End(xlUp).Row
MsgBox lastRow_1
counter_1 = 1
For counter_1 = 1 To lastRow_1
If Trim(Range("R" & counter_1).Value) = "" Then
Set aCell = Range("R" & counter_1)
rng_1 = Union(rng_1, aCell)
End If
Next
rng_1.Delete xlUp
End Sub
Assuming R200 is the last cell in the range
range("R1:R200").SpecialCells(xlCellTypeBlanks).Delete
Related
There are two sheets - Source and Target. There is a unique ID in both sheets in Column-A.
In TargetSheet based on the uniqueID (Column-A), I want to fetch values from SourceSheet(Column-B) to TargetSheet(Column-B).
There are unique IDs in TargetSheet(Column-A) which are not in SourceSheet(Column-A), hence they should be left blank.
Sub Recon()
Dim lrow, i, j As Long
lrow = Range("A1048576").End(xlUp).Row
TargetSheet.Activate
Range("A1").Select
j = 1
For i = 3 To lrow
Do
j = j + 1
If Range("A" & i) = SourceSheet.Range("A" & j) Then
Cells(i, 2) = SourceSheet.Range("B" & j).Value
End If
Loop Until Range("A" & i) = SourceSheet.Range("A" & j)
Next i
End Sub
You can do it combining VLOOKUP trapped into an IFERROR to handle missing ids. VLOOKUP will look a value in a column and if found, will return a value in same row but different custom column. If there is no coincidence, it will raise an error, so we combine it with IFERROR to transform that error into blank value, which means that id is not found.
VLOOKUP function
IFERROR function
My fake data is just 2 sheets like yours:
The code I've used:
Sub test()
Dim WKsource As Worksheet
Dim WKTarget As Worksheet
Dim UF As Long
Set WKsource = ThisWorkbook.Worksheets("SourceSheet")
Set WKTarget = ThisWorkbook.Worksheets("TargetSheet")
With WKTarget
UF = .Range("A" & .Rows.Count).End(xlUp).Row
.Range("B2:B" & UF).FormulaR1C1 = "=IFERROR(VLOOKUP(RC[-1]," & WKsource.Name & "!C1:C2,2,FALSE),"""")" 'get values
.Range("B2:B" & UF) = .Range("B2:B" & UF).Value 'paste formula results as values
End With
Set WKTarget = Nothing
Set WKsource = Nothing
End Sub
My final output:
Try this:
`Sub Test()
Dim Source As Range
Set Source = ThisWorkbook.Worksheets("Source").Range("A2:A5")
Dim Target As Range
Set Target = ThisWorkbook.Worksheets("Target").Range("A2:A6")
Dim TargetCell As Range
Dim FoundCell As Range
For Each TargetCell In Target
Set FoundCell = Source.Find(TargetCell.Value, _
Source.Cells(1, 1), _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchDirection:=xlNext)
If Not FoundCell Is Nothing Then
TargetCell.Offset(, 1) = FoundCell.Offset(, 1)
End If
Next TargetCell
End Sub`
I have a Sheet with columns A through F. I'm looking for the program to run through all the rows (Is there a way for it to only do active rows?) and check if D1 & E1 & F1 are blank, then hide the row (and so on).
Here's what I have which doesn't really work too well....
Sub Celltest2()
Dim rw As Range, cel As Range
Dim i As Integer
Dim celset As Range
For Each rw In Sheets("Phonelist").Range("D2:F5000").Rows
For Each cel In rw.Cells
If Len(cel.Text) = 0 Then
cel.EntireRow.Hidden = True
End If
Next
Next
End Sub
Try the code below:
Sub Celltest2()
Dim rw As Range, cel As Range
Dim i As Integer
Dim celset As Range
Dim LastRow As Long
With Sheets("Phonelist")
' find last row with data in Columns "D, "E" and "F" >> modify to your needs
LastRow = WorksheetFunction.Max(.Cells(.Rows.Count, "D").End(xlUp).Row, _
.Cells(.Rows.Count, "E").End(xlUp).Row, _
.Cells(.Rows.Count, "F").End(xlUp).Row)
For Each rw In .Range("D2:F" & LastRow).Rows
If WorksheetFunction.CountA(Range("D" & rw.Row & ":F" & rw.Row)) = 0 Then
rw.EntireRow.Hidden = True
End If
Next rw
End With
End Sub
Option 2: You can replace the loop above (the one that starts with For Each rw In .Range("D2:F" & LastRow).Rows) with the following loop:
For i = 2 To LastRow
If WorksheetFunction.CountA(Range("D" & i & ":P" & i)) = 0 Then
Rows(i).EntireRow.Hidden = True
End If
Next i
I am tring to alter this code FindReplace_With_Offset_1 to FindReplace_With_Offset_2
FindReplace_With_Offset_1 Run on a Col Range and it works fine
I need FindReplace_With_Offset_2 to run only on each Cell in the Col Range i.e. I need each cell to be its own range, when I run it I get #NAME? for every Cell with value #N/A
Thanks
Sub FindReplace_With_Offset_1()
Dim wsFR As Worksheet, wsT As Worksheet
Dim tLR As Long, i As Long
Set wsT = ThisWorkbook.Worksheets("XXX")
Set wsFR = ThisWorkbook.Worksheets("ZZZ")
With wsT
tLR = .Range("C" & .Rows.Count).End(xlUp).Row
With .Range("B2:B" & tLR) 'The Offset Range
.Value = _
"=VLOOKUP(D2," & wsFR.Range("D1").CurrentRegion.Address(1, 1, , 1) & ",2,0)"
.Value = .Value
End With
End With
End Sub
Code2
Sub FindReplace_With_Offset_2()
Dim wsFR As Worksheet, wsT As Worksheet
Dim Rng As Range, aCell As Range
Dim tLR As Long, i As Long
Set wsT = ThisWorkbook.Worksheets("XXX")
Set wsFR = ThisWorkbook.Worksheets("ZZZ")
With wsT
tLR = .Range("C" & .Rows.Count).End(xlUp).Row
Set Rng = .Range("A2:A" & tLR)
For Each aCell In Rng
If aCell.text = "#N/A" Then
aCell.Value = _
"=VLOOKUP(aCell," & wsFR.Range("C1").CurrentRegion.Address(1, 1, , 1) & ",2,0)"
aCell.Value = aCell.Value
Else
aCell = aCell
End If
Next aCell
End With
End Sub
Maybe it's because you're trying to put the code to read a error value, and for the excel the cell value isn't the text "#N/A", try to use the IfError formula to run the verification on the desired cell, like this:
If WorksheetFunction.IfError(aCell,"Error") = "Error" Then
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
In excel 2010, how to do a validation if cell contain ',' then pop up a message to user ?
Please try to show your work ..
lets say Column A contains the data then below code work perfectly
this is what u wanted (TESTED)
Sub tested()
Dim erange As Range
Dim lrow As Integer
lrow = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row
For Each erange In Range("A2:A" & lrow)
If InStr(erange.Value, ",") > 0 Then
MsgBox (erange.Address & " contains Comma ")
erange.Interior.Color = vbRed
End If
Next erange
End Sub
Using normal data validation, you could try this
=(LEN(A1) = LEN(SUBSTITUTE(A1,",","")))
If you want to avoid unnecessary loop use below code.
Sub findComma()
Dim srcRng As Range, findRng As Range
Dim firstCell As String
Dim lrow As Integer
lrow = Range("A" & Rows.Count).End(xlUp).Row
Set srcRng = Range("A1:A" & lrow)
Set findRng = srcRng.Find(What:=",", LookIn:=xlValues, LookAt:=xlPart)
If Not findRng Is Nothing Then firstCell = findRng.Address
Do Until findRng Is Nothing
MsgBox (findRng.Address & " contains Comma ")
findRng.Interior.Color = vbRed
Set findRng = srcRng.FindNext(findRng)
If findRng.Address = firstCell Then Exit Sub
Loop
End Sub