If
r = 1, and
c = 1
the intended code below is invalid (it tries to return a cell two columns to the left of Column A)
Cells(r, c).Offset(0, -2)
How do I check whether the intended cell is valid or not in vba?
Use a Range object to test whether it is valid (preferred for versatility)
Test whether the column is valid (assumes hard-code of your OFFSET as (0,2)
(1) code
Sub Test1()
Dim r As Long
Dim c As Long
r = 1
c = 1
Dim rng1 As Range
On Error Resume Next
Set rng1 = Cells(r, c).Offset(0, -2)
On Error GoTo 0
If Not rng1 Is Nothing Then
'proceed with your code - range exists
Else
MsgBox "Range Error", vbCritical
End If
End Sub
(2) code
Sub Test2()
Dim rng1 As Range
Dim r As Long
Dim c As Long
c = 3
r = 1
If c - 2 <= 0 Then
MsgBox "Error", vbCritical
Else
Set rng1 = Cells(r, c).Offset(0, -2)
End If
End Sub
Here is example for you.
Sub sample()
Dim r As Integer
Dim c As Integer
r = 1
c = 1
Dim validRng As Boolean
validRng = isValidRng(r, c, 0, -2)
Debug.Print validRng
validRng = isValidRng(r, c + 5, 0, 2)
Debug.Print validRng
validRng = isValidRng(r, c, -1, 0)
Debug.Print validRng
validRng = isValidRng(r, c + 2, 0, -1)
Debug.Print validRng
End Sub
Function isValidRng(row As Integer, col As Integer, offsetrow As Integer, offsetcol As Integer) As Boolean
'Returns if its valid range
If ((row + offsetrow) > 0) And ((col + offsetcol) > 0) Then
isValidRng = True
Else
isValidRng = False
End If
End Function
Related
I have a list with 3 variables in the sheet "Combined" in columns A; B; C.
The workbook contains 98 sheets, with those 3 variables still in A; B; C columns but in different combinations and with a fourth column which never repeats itself, as the sheets go on, which i need to bring in the "Combined" sheet, always adding another column for the next sheet I vlookup. : A B C + D(from the next sheet) + E(from the next sheet) and so on.
I have a UDF that Vlookups on 3 based on 3 criterias and a macro that cycles through the sheets and bring the values where i want them. The problem is, it's pretty slow, left it from yesterday and its on sheet 60. Any suggestions on improving it would greatly help, Thank you in advance!
Function ThreeVlookup(Table_Range As Range, Return_Col As Long, Col1_Fnd, Col2_Fnd, Col3_Fnd)
Dim rCheck As Range, bFound As Boolean, lLoop As Long
On Error Resume Next
Set rCheck = Table_Range.Columns(1).Cells(1, 1)
With WorksheetFunction
For lLoop = 1 To .CountIf(Table_Range.Columns(1), Col1_Fnd)
Set rCheck = Table_Range.Columns(1).Find(Col1_Fnd, rCheck, xlValues, xlWhole, xlNext, xlRows, False)
If UCase(rCheck(1, 2)) = UCase(Col2_Fnd) And UCase(rCheck(1, 3)) = UCase(Col3_Fnd) Then
bFound = True
Exit For
End If
Next lLoop
End With
If bFound = True Then
ThreeVlookup = rCheck(1, Return_Col)
Else
ThreeVlookup = ""
End If
End Function
Sub test()
Dim lookupVal1 As Range, lookupVal2 As Range, lookupVal3 As Range, myString As Variant, n&, u As Long
n = Sheets("Combined").[A:A].Cells.Find("*", , , , xlByRows, xlPrevious).Row
u = 4
For j = 2 To Worksheets.Count
For i = 1 To n
Set lookupVal1 = Sheets("Combined").Cells(i, 1)
Set lookupVal2 = Sheets("Combined").Cells(i, 2)
Set lookupVal3 = Sheets("Combined").Cells(i, 3)
myString = ThreeVlookup(Sheets(j).Range("A:D"), 4, lookupVal1, lookupVal2, lookupVal3)
Sheets("Combined").Cells(i, u) = myString
Next i
u = u + 1
Next j
End Sub
Use Arrays to speed it up, my friend! Load all your sheets (or just the current sheet in the loop) into an array in VBA's memory and do the .CountIf and .Find on arrayVar(row) instead of Table_Range.Columns(1).
You will be really surprised how much quicker it goes. Do it!
Here's a tutorial I like on arrays...
http://www.cpearson.com/excel/ArraysAndRanges.aspx
Here's a guy who speed-tested an application like yours...
https://fastexcel.wordpress.com/2011/10/26/match-vs-find-vs-variant-array-vba-performance-shootout/
The basics is like this:
Sub Play_With_Arrays()
Dim varArray() As Variant
Dim lngArray() As Long
ReDim varArray(1 To 1000)
ReDim lngArray(1 To 1000)
For A = 1 To 1000
lngArray(A) = A / 2
varArray(A) = A / 2 & " examples"
Next
searchterm = 345
For B = 1 To 1000
If lngArray(B) = searchterm Then
FoundRow = B
End If
Next
searchterm2 = "5 ex"
FoundStrRowCount = 0
For C = 1 To 1000
If InStr(1, varArray(C), searchterm2, vbBinaryCompare) Then
FoundStrRowCount = FoundStrRowCount + 1
End If
Next
MsgBox (FoundRow & " in long array and " & FoundStrRowCount & " in var array")
End Sub
Something like this should be much faster:
Public Function ThreeVLookup(ByVal arg_Col1LookupVal As Variant, _
ByVal arg_Col2LookupVal As Variant, _
ByVal arg_Col3LookupVal As Variant, _
ByVal arg_LookupTable As Range, _
ByVal arg_ReturnColumn As Long) _
As Variant
Dim rConstants As Range, rFormulas As Range
Dim rAdjustedTable As Range
Dim aTable As Variant
Dim i As Long
On Error Resume Next
Set rConstants = arg_LookupTable.SpecialCells(xlCellTypeConstants)
Set rFormulas = arg_LookupTable.SpecialCells(xlCellTypeFormulas)
On Error GoTo 0
Select Case (Not rConstants Is Nothing) + 2 * (Not rFormulas Is Nothing)
Case 0: ThreeVLookup = vbNullString
Exit Function
Case -1: Set rAdjustedTable = rConstants
Case -2: Set rAdjustedTable = rFormulas
Case -3: Set rAdjustedTable = Union(rConstants, rFormulas)
End Select
If WorksheetFunction.CountIfs(rAdjustedTable.Resize(, 1), arg_Col1LookupVal, rAdjustedTable.Resize(, 1).Offset(, 1), arg_Col2LookupVal, rAdjustedTable.Resize(, 1).Offset(, 2), arg_Col3LookupVal) = 0 Then
ThreeVLookup = vbNullString
Exit Function
End If
aTable = rAdjustedTable.Value
For i = LBound(aTable, 1) To UBound(aTable, 1)
If aTable(i, 1) = arg_Col1LookupVal And aTable(i, 2) = arg_Col2LookupVal And aTable(i, 3) = arg_Col3LookupVal Then
ThreeVLookup = aTable(i, arg_ReturnColumn)
Exit Function
End If
Next i
End Function
Sub tgr()
Dim wb As Workbook
Dim wsCombined As Worksheet
Dim ws As Worksheet
Dim aResults() As Variant
Dim aCombined As Variant
Dim i As Long, j As Long
Set wb = ActiveWorkbook
Set wsCombined = wb.Sheets("Combined")
aCombined = wsCombined.Range("A1").CurrentRegion.Value
ReDim aResults(1 To UBound(aCombined, 1) - LBound(aCombined, 1) + 1, 1 To wb.Sheets.Count - 1)
For i = LBound(aCombined, 1) To UBound(aCombined, 1)
j = 0
For Each ws In wb.Sheets
If ws.Name <> wsCombined.Name Then
j = j + 1
aResults(i, j) = ThreeVLookup(aCombined(i, 1), aCombined(i, 2), aCombined(i, 3), ws.Range("A:D"), 4)
End If
Next ws
Next i
wsCombined.Range("D1").Resize(UBound(aResults, 1), UBound(aResults, 2)).Value = aResults
End Sub
In VBA Excel, if I have a table. How do I check the cells outside the table in all 4 sides of it, for 10 rows and 10 columns, as empty or not?
Thanks
Jeevan
You could use this function:
Option Explicit
Function NonBlankCellsOutside(rng As Range, rowsOutside As Long, colsOutside As Long)
Dim outside As Range
Dim rowsBefore As Long
Dim colsBefore As Long
rowsBefore = IIf(rng.Row <= rowsOutside, rng.Row - 1, rng.Row - rowsOutside)
colsBefore = IIf(rng.Column <= colsOutside, rng.Column - 1, rng.Column - colsOutside)
Set outside = rng.Offset(-rowsBefore, -colsBefore) _
.Resize(rng.Rows.Count + rowsBefore + rowsOutside, _
rng.Columns.Count + colsBefore + colsOutside)
NonBlankCellsOutside = WorksheetFunction.CountA(outside) _
- WorksheetFunction.CountA(rng)
End Function
Example use with a normal range:
Dim ok As Boolean
ok = NonBlankCellsOutside(Worksheets(1).Range("C20:F50"), 10, 10) = 0
If Not ok Then MsgBox "There are non-blank cells in the neighbourhood"
Another example with a named table:
Dim num As Long
num = NonBlankCellsOutside(ActiveSheet.ListObjects("Table1").Range, 5, 5)
MsgBox "There are " & num & " non-blank cells around the table"
You can do this with in-cell formulae.
Given a table named Table1 whose top-left corner is no closer to the top or to the left than K11, and the following formulae, the value in A5 will give you your answer:
A B C
1
2 Range start =ROW(Table1)-10 =COLUMN(Table1)-10
3 Range end =ROW(Table1)+ROWS(Table1)+9 =COLUMN(Table1)+COLUMNS(Table1)+9
4
5 =AND(B2>0, B3>0, COUNTA(INDIRECT("r"&B2&"c"&C2&":r"&B3&"c"&C3, FALSE))=COUNTA(Table1[#All]))
Here I have something that works for any named table, as long as its first cell is no closer to the edges than K11.
Sub checkSurroundings()
Dim tws As Worksheet
Dim tb1 As ListObject
Dim tb1_address As String
Dim c() As String 'Table range, first and last cell
Dim rngL, rngR, rngU, rngD As Range
Dim tmpRange As Range
Dim cnt As Integer
Set tws = ThisWorkbook.Worksheets("Sheet1")
Set tb1 = tws.ListObjects("Table1")
tb1_address = tb1.Range.Address
'Debug.Print tb1_address
c() = Split(tb1_address, ":", -1, vbTextCompare)
'Debug.Print c(0)
'Debug.Print c(1)
cnt = 0
With tws
'Range Left
Set rngL = Range(.Range(c(0)).Offset(-10, -10), .Cells(.Range(c(1)).Row + 10, .Range(c(0)).Column - 1))
'Range Right
Set rngR = Range(.Cells(.Range(c(0)).Row - 10, .Range(c(1)).Column + 1), .Range(c(1)).Offset(10, 10))
'Range Up
Set rngU = Range(.Range(c(0)).Offset(-10, 0), .Cells(.Range(c(0)).Row - 1, .Range(c(1)).Column))
'Range Down
Set rngD = Range(.Cells(.Range(c(1)).Row + 1, .Range(c(0)).Column), .Range(c(1)).Offset(10, 0))
End With
For i = 1 To 4
Select Case i
Case 1
Set tmpRng = rngL
Case 2
Set tmpRng = rngR
Case 3
Set tmpRng = rngU
Case 4
Set tmpRng = rngD
End Select
For Each cell In tmpRng
If Not IsEmpty(cell) Then
cnt = cnt + 1
End If
Next cell
Next i
If cnt > 0 Then
MsgBox ("The area around Table1 (+-10) is not empty. There are " & cnt & " non-empty cells.")
Else
MsgBox ("The area around Table1 (+-10) is empty.")
End If
End Sub
I have the following code and it works perfectly fine. But instead of Range("A"), I want to select a column by its name.
Option Explicit
'// Campare and Hilight Unique
Sub CompareHighlightUnique()
Dim Range1 As Range
Dim Range2 As Range
Dim i As Integer
Dim j As Integer
Dim isMatch As Boolean
For i = 2 To Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Row
isMatch = False
Set Range1 = Sheets("Sheet1").Range("A" & i)
For j = 1 To Sheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Row
Set Range2 = Sheets("Sheet2").Range("A" & j)
If StrComp(Trim(Range1.Text), Trim(Range2.Text), vbTextCompare) = 0 Then
isMatch = True
Exit For
End If
Set Range2 = Nothing
Next j
If Not isMatch Then
Range1.Interior.Color = RGB(255, 0, 0)
End If
Set Range1 = Nothing
Next i
End Sub
your updated code below
Option Explicit
'// Campare and Hilight Unique
Sub CompareHighlightUnique()
Dim Range1 As Range, Range2 As Range, i&, j&, isMatch As Boolean
Dim Z&: Z = Cells.Find("Column Name", , , , , , True).Column 'here
For i = 2 To Sheets("Sheet1").Cells(Rows.Count, Z).End(xlUp).Row 'here
isMatch = False
Set Range1 = Sheets("Sheet1").Cells(i, Z) 'here
For j = 1 To Sheets("Sheet2").Cells(Rows.Count, Z).End(xlUp).Row 'here
Set Range2 = Sheets("Sheet2").Cells(j, Z) 'and here
If StrComp(Trim(Range1.Text), Trim(Range2.Text), vbTextCompare) = 0 Then
isMatch = True
Exit For
End If
Set Range2 = Nothing
Next j
If Not isMatch Then
Range1.Interior.Color = vbRed
End If
Set Range1 = Nothing
Next i
End Sub
replace column name with required column name (variable Z)
I want to create a macro for the following:
For each row, if there are cell values in range C3:ACP3 that are >= value of ACU3, I want to replace that cell value with blank. I want to do this for every row, and each time the macro should reference the value in the ACU column for that row.
Try this:
Sub makeBlank()
Dim r As Range
Set r = Excel.ThisWorkbook.Sheets("Sheet1").Range("C3:ACP3")
Dim v As Double
v = Excel.ThisWorkbook.Sheets("Sheet1").Range("ACU3").Value
Dim c
For Each c In r
If c.Value >= v Then
c.Value = ""
End If
Next c
End Sub
EDIT
I suspect this will be quicker using arrays:
Sub makeBlank2()
Dim v
v = Excel.ThisWorkbook.Sheets("Sheet1").Range("ACU3").Value
Dim Arr() As Variant
Arr = Sheet1.Range("C3:ACP3")
Dim R, C As Long
For R = 1 To UBound(Arr, 1)
For C = 1 To UBound(Arr, 2)
If Arr(R, C) > v Then
Arr(R, C) = ""
End If
Next C
Next R
Sheet1.Range("C3:ACP3") = Arr
End Sub
Try this:
Sub FindDelete()
Dim ACU_Val As Double
Dim cl As Range
Dim rw As Long
For rw = 1 To Rows.Count
If Range("ACU" & rw).Value = "" Then Exit For
ACU_Val = Range("ACU" & rw).Value
For Each cl In Range("C" & rw & ":ACP" & rw)
If cl.Value >= ACU_Val Then cl.Value = ""
Next cl
Next
End Sub
you need to iterate over your desired range of cells and for each cell which contents are above the threshold value in the ACU column of the same row just clear its contents.
For Each c In Range("C3:ACP3")
If c.Value >= Cells(c.Row, "ACU") Then
c.clearContents
End If
Next c
Simple :
Dim myCell As Range
numberOfRows = 1000
For i = 0 To numberOfRows
Dim myRow As Range
Set myRow = [C3:ACP3].Offset(i, 0)
bound = Intersect([acu3].EntireColumn, myRow.EntireRow)
For Each myCell In myRow
If myCell >= bound Then myCell = ""
Next
Next
I am able to search a text in column A of my spreadsheet by using this
With WB.Sheets("MySheet")
Set FindRow = .Range("A:A").Find(What:="ProjTemp1", LookIn:=xlValues)
End With
After which I can get the row number by doing FindRow.Row
How do I then get back the row number where Column A == "ProjTemp1" && Column B == "ProjTemp2" && Column C == "ProjTemp3"
Try to use Autofilter:
Dim rng As Range
'disable autofilter in case it's already enabled'
WB.Sheets("MySheet").AutoFilterMode = False
With WB.Sheets("MySheet").Range("A1:C1")
'set autofilter'
.AutoFilter Field:=1, Criteria1:="=ProjTemp1"
.AutoFilter Field:=2, Criteria1:="=ProjTemp2"
.AutoFilter Field:=3, Criteria1:="=ProjTemp3"
End With
With WB.Sheets("MySheet")
On Error Resume Next
Set rng = .Range("A2:A" & .Rows.Count).Rows.SpecialCells(xlCellTypeVisible)
On Error GoTo 0
End With
If Not rng Is Nothing Then
MsgBox rng.Row ' returns first visible row number
End If
WB.Sheets("MySheet").AutoFilterMode = False 'disable autofilter'
An alternative suggestion is to just loop through the table and use nested if-statements like this:
Sub ReturnRowNumber()
Dim i As Long, GetRow As Long
For i = 2 To Sheets("MySheet").Cells(Rows.Count, 1).End(xlUp).Row
'Criteria search
If Sheets("MySheet").Cells(i, 1).Value = "ProjTemp1" Then
If Sheets("MySheet").Cells(i, 2).Value = "ProjTemp2" Then
If Sheets("MySheet").Cells(i, 3).Value = "ProjTemp3" Then
'Returns row
GetRow = i
End If
End If
End If
Next i
End Sub
Just posted similar reply at MSDN and wanted to share here if anyone is still using VBA. The function for multiple match that works pretty fast.
It might help a lot if you are interested in effective code since using Application.Match() is much much faster that Find() or INDEX() method or simple looping.
The syntax is the same as COUNTIFS() but it returns the match index instead of counting.
Public Function MultiMatch(ParamArray X0() As Variant) As Variant
MultiMatch = CVErr(xlErrNA)
If UBound(X0) = -1 Then Exit Function
On Error GoTo ErrorHandler
Set Xws = X0(1).Parent
X_rFrow = X0(1)(1, 1).Row
X_rLrow = X_rFrow + X0(1).Rows.Count - 1
jLAST = UBound(X0)
l = X_rFrow
j = 0
Do While IsError(MultiMatch) And j + 1 <= jLAST And Not IsError(X1)
jCOL = X0(j + 1).Column
Set TRNG = Xws.Range(Xws.Cells(l, jCOL), Xws.Cells(X_rLrow, jCOL))
X1 = Application.Match(X0(j), TRNG, 0)
If Not IsError(X1) Then
l = TRNG(X1).Row
If X1 = 1 Then
If j + 1 = jLAST Then
MultiMatch = l - X_rFrow + 1
Else
j = j + 2
End If
Else
j = 0
End If
End If
Loop
Exit Function
ErrorHandler:
MultiMatch = CVErr(xlErrName)
End Function
This can work in such a way that X amount of values to search are Y columns to search for X values in a row, having 0 as a result of nothing and Row>= 1 the row that has the X amount of values per column in the same row.
Public Function find(sheetName As String, initCol As Integer, initRow As Integer, ParamArray values()) As Variant
Dim i As Long, GetRow As Long
On Error GoTo nextRow
For i = initRow To Sheets(sheetName).cells(Rows.Count, 1).End(xlUp).row
For ii = 0 To UBound(values)
If Sheets(sheetName).cells(i, initCol + ii).Value2 = values(ii) Then
GetRow = ii
If ii = UBound(values) Then
find = i
Exit Function
End If
GoTo nextCol
End If
If ii = 0 Then GoTo nextRow
nextCol:
Next ii
nextRow:
Next i
endFind:
find = GetRow
End Function
Use :
vRow = find("sheet", 1, 1, "test", "test1","test2")
"sheet" = sheetName, 1 = Col index start, 1 = row number start, ["test","test1","test2"] is ParamArray
"find" Function will search "test" in colunm A, "test1" in B &
"test2" in C and it will return the row number that has these values
followed in the same row