I can't evaluate the sumproduct at the end of the code. I think everything else is working but I keep getting the
Type Mismatch Error
I've tried all sorts of variations of syntax and I still can't get it to work. Any ideas?
Sub Sample()
Dim ws As Worksheet
Dim x As Long
Dim lRow As Long, llRow As Long
Dim aCell As Range, bCell As Range
Dim rng1 As Range, rng2 As Range
Set ws = ThisWorkbook.Sheets("Sheet1")
With ws
Set aCell = .Range("B6:E20").Find(Cells(14, 9).Offset(0, -1).Value)
If Not aCell Is Nothing Then
lRow = .Range(Split(.Cells(, aCell.Column).Address, "$")(1) & .Rows.Count).End(xlUp).Row
If lRow > 1 Then
Set rng1 = .Range(aCell.Offset(1), .Cells(lRow, aCell.Column))
End If
End If
Set bCell = .Range("B6:E20").Find(Cells(14, 9).Offset(-1, 0).Value)
If Not bCell Is Nothing Then
llRow = .Range(Split(.Cells(, bCell.Column).Address, "$")(1) & .Rows.Count).End(xlUp).Row
If llRow > 1 Then
Set rng2 = .Range(bCell.Offset(1), .Cells(lRow, bCell.Column))
End If
End If
Debug.Print rng1.Address
Debug.Print rng2.Address
x = Evaluate("=sumproduct(""rng1"",""rng2"")")
End With
End Sub
rng1 and rng2 doesn't mean anything to Sumproduct function as it is not a Named Range or a valid range address. And so Evaluate function fails.
To make it work try:
x = Evaluate("=sumproduct(" & rng1.Address & "," & rng2.Address & ")")
Now to make sure that you evaluate your correct ranges, you might want to set the External argument of Address property to True.
x = Evaluate("=Sumproduct(" & rng1.Address(, , , True) & _
"," & rng2.Address(, , , True) & ")")
Related
So i need to add 2021 to the Assessment year column in my worksheet but the range keeps breaking
LastRow is returning the correct value but i cant manage to figure out why range isnt working
Sub AutoFill()
Dim rFind As Range
Dim ColumnLetter As Variant
Dim ColumnNumber As Variant
Dim LastRow As Variant
Dim Fill As Range
With Range("A1:P1")
Set rFind = .Find(What:="AssessmentYear", LookAt:=xlWhole, MatchCase:=False, SearchFormat:=False)
If Not rFind Is Nothing Then
ColumnNumber = rFind.Column
ColumnLetter = Split(Cells(1, ColumnNumber).Address, "$")(1)
LastRow = Cells(Rows.Count, 1).End(xlUp).Row
MsgBox ColumnLetter
MsgBox LastRow
Cells(LastRow, ColumnNumber).Value = "Here"
Range("ColumnLetter & 2 : ColumnLetter & LastRow").Value = "2021"
End If
End With
End Sub
I keep getting a method global failed error
The issue is VBA sees "ColumnLetter & 2 : ColumnLetter & LastRow" as a string and is not actually using the variables ColumnLetter or LastRow. Just change it to the below and it should work fine.
Range(ColumnLetter & "2 : " & ColumnLetter & LastRow).Value = "2021"
Auto Fill Data Column
Option Explicit
Sub AutoFillDataColumn()
Const hAddress As String = "A1:P1"
Const hTitle As String = "AssessmentYear"
Const cValue As Variant = 2021
Dim ws As Worksheet: Set ws = ActiveSheet
Dim hrg As Range: Set hrg = ws.Range(hAddress)
Dim rg As Range: Set rg = RefDataColumnByHeader(hrg, hTitle)
If rg Is Nothing Then Exit Sub
rg.Value = cValue
End Sub
Function RefDataColumnByHeader( _
ByVal HeaderRange As Range, _
ByVal HeaderTitle As String) _
As Range
If HeaderRange Is Nothing Then Exit Function
Dim hCell As Range
With HeaderRange
Set hCell = .Find(HeaderTitle, .Cells(.Rows.Count, .Columns.Count), _
xlFormulas, xlWhole, xlByRows)
If hCell Is Nothing Then Exit Function
If hCell.Row = .Worksheet.Rows.Count Then Exit Function
Debug.Print "Header Cell Address: " & hCell.Address(0, 0)
End With
Dim hrrg As Range
Set hrrg = Intersect(HeaderRange, hCell.EntireRow)
Debug.Print "Header Row Range Address: " & hrrg.Address(0, 0)
With hrrg
Dim lcrg As Range
Set lcrg = .Resize(.Worksheet.Rows.Count - .Row).Offset(1)
Debug.Print "Last Cell Range Address: " & lcrg.Address(0, 0)
Dim lCell As Range
Set lCell = lcrg.Find("*", , xlFormulas, , xlByRows, xlPrevious)
If lCell Is Nothing Then Exit Function
Debug.Print "Last Cell Address: " & lCell.Address(0, 0)
Set RefDataColumnByHeader = hCell.Resize(lCell.Row - .Row).Offset(1)
Debug.Print "Data Column Address: " _
& RefDataColumnByHeader.Address(0, 0)
End With
End Function
I adapted code I found online.
It finds the string "car" in column A and returns the rows as an array
It assigns a variable to the length of the array (how many matches it found)
It assigns a variable to generate a random number between 0 and the length of the array
It then prints a random matching row's value into K3
Dim myArray() As Variant
Dim x As Long, y As Long
Dim msg As String
With ActiveSheet.Range("A1:A" & ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row)
Set c = .find("Car", LookIn:=xlValues)
If Not c Is Nothing Then
firstAddress = c.Address
Do
ReDim Preserve myArray(y)
myArray(y) = c.Row
y = y + 1
Set c = .findNext(c)
If c Is Nothing Then
GoTo DoneFinding
End If
Loop While c.Address <> firstAddress
End If
DoneFinding:
End With
For x = LBound(myArray) To UBound(myArray)
msg = msg & myArray(x) & " "
Next x
ArrayLen = UBound(myArray) - LBound(myArray)
random_index = WorksheetFunction.RandBetween(0, ArrayLen)
MsgBox myArray(random_index)
Dim test As String
test = "B" & myArray(random_index)
Range("K3").Value = Range(test)
Example
I'm struggling with adapting the find code to allow for multiple criteria. So in my example, it finds "Car". What if I want to find matches that had "Car" in column A and "Red" in column D?
I tried
With ActiveSheet.Range("A1:A" & "D1:D" & ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row & ActiveSheet.Range("D" & Rows.Count).End(xlUp).Row)
Set c = .find("Car", "Red", LookIn:=xlValues)
I get type mismatch on the Set line.
In case it is confusing, it currently looks for a string e.g. "Car" but I will eventually link this to the variable which will be assigned to a data validation list. So if the user chooses "car" from a drop down list, this is what it will search for.
Maybe Advancde Filter is something that fit your needs:
Example Code
Option Explicit
Public Sub FilterData()
Dim ws As Worksheet
Set ws = ThisWorkbook.Worksheets("YourSheetName")
Dim LastRow As Long
LastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
Dim CriteriaRange As Range
Set CriteriaRange = ws.Range("A1", "E2")
Dim DataRange As Range
Set DataRange = ws.Range("A4", "E" & LastRow)
DataRange.AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:=CriteriaRange, Unique:=False
End Sub
Public Sub ShowAll()
On Error Resume Next
ActiveSheet.ShowAllData
On Error GoTo 0
End Sub
Edit according comment:
You can use the advanced filter and then loop through the filter results:
Option Explicit
Public CurrentRow As Long
Public Sub FilterData()
Dim ws As Worksheet
Set ws = ThisWorkbook.Worksheets("YourSheetName")
Dim LastRow As Long
LastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
Dim CriteriaRange As Range
Set CriteriaRange = ws.Range("A1", "E2")
Dim DataRange As Range
Set DataRange = ws.Range("A4", "E" & LastRow)
DataRange.AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:=CriteriaRange, Unique:=False
End Sub
Public Sub ShowAll()
On Error Resume Next
ActiveSheet.ShowAllData
CurrentRow = 1
On Error GoTo 0
End Sub
Public Sub GetNextResult()
FilterData
Dim ws As Worksheet
Set ws = ThisWorkbook.Worksheets("YourSheetName")
Dim LastRow As Long
LastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
Dim DataRange As Range
Set DataRange = ws.Range("A4", "E" & LastRow)
Dim FilteredData As Range
Set FilteredData = DataRange.Resize(ColumnSize:=1).SpecialCells(xlCellTypeVisible)
If CurrentRow + 1 > FilteredData.Cells.Count Then
CurrentRow = 1
End If
CurrentRow = CurrentRow + 1
Dim i As Long
Dim Cell As Variant
For Each Cell In FilteredData
i = i + 1
If i = CurrentRow Then
Cell.EntireRow.Select
'or
'MsgBox Cell.Value & vbCrLf & Cell.Offset(0, 1) & vbCrLf & Cell.Offset(0, 2) & vbCrLf & Cell.Offset(0, 3) & vbCrLf & Cell.Offset(0, 4)
End If
Next Cell
End Sub
The code below executes but the:
For i = 2 To lRow
If .Range("A" & i).Value = rng1 Then
If .Range("C" & i).Value = rng2 Then
lastcell = .Range("B" & i).Value
End If
End If
Next i
Does not seem to be doing what I have intended. What I intended was that if the cell A & i's value = lets say rng1, if that is true then move on to the next parameter and check if that i's C column cell = rng2 if that is correct then take that row i's B column and set cell "C3" on the proof tab equal to B & i's value. Then move on to the next i; if it finds another B that fit the two conditions above, then set cell c3.offset(1) = to that i's value. This unfortunately is not working for me. ANyone have any suggestions :)
This is what it looks like when I run the code:
Sub Extract_Bank_Amount()
Dim wb As Workbook
Dim ws As Worksheet
Dim rng1 As Range, rng2 As Range, lastcell As Range
Dim lRow As Long, i As Long
Set wb = ActiveWorkbook
Set ws = wb.Sheets("Bank Statement")
Set rng1 = wb.Sheets("Payroll Journal").Range("B1")
Set rng2 = wb.Sheets("Payroll Journal").Range("B3")
Set lastcell = wb.Sheets("Proof").Range("C3" & Rows.Count).End(xlUp).Offset(1)
wb.Sheets("Bank Statement").Activate
With ws
lRow = .Range("B" & .Rows.Count).End(xlUp).Row
For i = 2 To lRow
If .Range("A" & i).Value = rng1 Then
If .Range("C" & i).Value = rng2 Then
lastcell = .Range("B" & i).Value
End If
End If
Next i
End With
End Sub
You need to find the next empty cell each time you add a value to the end of the list.
Sub Extract_Bank_Amount()
Dim wb As Workbook
Dim ws As Worksheet
Dim rng1 As Range, rng2 As Range, lastcell As Range
Dim lRow As Long, i As Long
Set wb = ActiveWorkbook
Set ws = wb.Sheets("Bank Statement")
Set rng1 = wb.Sheets("Payroll Journal").Range("B1")
Set rng2 = wb.Sheets("Payroll Journal").Range("B3")
wb.Sheets("Bank Statement").Activate
With ws
lRow = .Range("B" & .Rows.Count).End(xlUp).Row
For i = 2 To lRow
If .Range("A" & i).Value = rng1 Then
If .Range("C" & i).Value = rng2 Then
With wb.Sheets("Proof")
.Range("C" & .Rows.Count).End(xlUp).Offset(1).Value = .Range("B" & i).Value
End With
End If
End If
Next i
End With
End Sub
I would give the ranges on "Payroll Journal" meaningful names then used their Defined Names to refer to them.
wb.Sheets("Payroll Journal").Range("B1").Name = "PayrollB1"
wb.Sheets("Payroll Journal").Range("B3").Name = "PayrollB3"
This will allow you to get rid of a lot of the fluff.
Sub Extract_Bank_Amount2()
Dim cell As Range
With Worksheets("Bank Statement")
For Each cell In .Range("B" & .Rows.Count).End(xlUp)
If cell.Offset(0, -1).Value = Range("PayrollB1").Value Then
If cell.Offset(0, 1).Value = Range("PayrollB3").Value Then
With wb.Sheets("Proof")
.Range("C" & .Rows.Count).End(xlUp).Offset(1).Value = cell.Value
End With
End If
End If
Next
End With
End Sub
You should also download Rubberduck. Rubberduck is a COM add-in for the VBA IDE that will help you debug and optimise your code. Most importantly for me it saves me a ton of time by formatting my code for me.
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
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