I am trying to get a form to populate data from a sheet using cell Z as the lookup reference.
The dropdown on the form showing my list of issue references works. When I select an item from said list to populate the form I get the mismatch error.
Also, my range in Z column is a mix of letters and numbers. I did change I to variant but no luck
The application.match is returning an error. Any ideas?
Run Time error '13': Type Mismatch
Private Sub ComboBox2_Change()
If Me.ComboBox2.Value <> "" Then
Dim sh As Worksheet
Set sh = ThisWorkbook.Sheets("Inbound Issues")
Dim i As Integer
i = Application.Match(VBA.CLng(Me.ComboBox2.Value), sh.Range("Z:Z"), 0)
Me.TextBox1.Value = sh.Range("H" & i).Value
End If
End Sub
Private Sub ComboBox2_Change()
If Me.ComboBox2.Value <> "" Then
Dim sh As Worksheet
Set sh = ThisWorkbook.Sheets("Inbound Issues")
Dim i As Integer
i = Application.Match(VBA.Str(Me.ComboBox2.Value), sh.Range("Z:Z"), 0)
Me.TextBox1.Value = sh.Range("H" & i).Value
End If
End Sub
Change Clng to Str
Related
is there I way for searching a value on the next sheet (ActiveSheet.Next.Activate) without jumping on to it?
Here the whole Code:
the problem is, it jumps to the next sheet even if there is no searched value.
Dim ws As Worksheet
Dim Loc As Range
Dim StrVal As String
Dim StrRep As String
Dim i As Integer
Private Sub CommandButton1_Click()
i = 1
Call Replacing
End Sub
Private Sub CommandButton2_Click()
i = 2
Call Replacing
End Sub
Public Sub Replacing()
StrVal = Userform1.Textbox1.Text
StrRep = Me.Textbox1.Text
if Trim(StrVal) = "" Then Exit Sub
Dim fstAddress As String
Dim nxtAddress As String
For Each ws In ThisWorkbook.Worksheets
With ws
Set Loc = .Cells.Find(what:=StrVal)
fstAddress = Loc.Address
If Not Loc Is Nothing Then
If Not StrRep = "" And i = 1 Then
Loc.Value = StrRep
Set Loc = .Cells.FindNext(Loc)
ElseIf i = 2 Then Set Loc = Range(ActiveCell.Address)
Set Loc = .Cells.FindNext(Loc)
nxtAddress = Loc.Address
If Loc.Address = fstAddress Then
ActiveSheet.Next.Activate '****Here it should jump only if found something on the next sheet****
GoTo repeat
nxtAddress = Loc.Address
End If
If Not Loc Is Nothing Then Application.Goto ws.Range(nxtAddress), False
End If
i = 0
End If
End With
Set Loc = Nothing
repeat:
Next ws
End Sub
the variable "i" which switches between the values 0, 1 and 2 is bound to two buttons. these buttons are "Replace" and "Skip (to next found value)".
This code asks on each occurrence of StrVal whether you want to replace the value or skip it.
I found a problem checking if Found_Address = First_Found_Address:
If you've replaced the value in in First_Found_Address it won't find that address again and miss the starting point in the loop.
Also the original source of the code stops at the last value using Loop While Not c Is Nothing And c.Address <> firstAddress. The problem here is that if the value in c is being changed eventually c will be Nothing but it will still try and check the address of c - causing an error (Range Find Method).
My solution to this is to build up a string of visited addresses on the sheet and checking if the current address has already been visited using INSTR.
I've included the code for calling from a button click or from within another procedure.
Private Sub CommandButton1_Click()
FindReplace Userform1.Textbox1.Text, 1
End Sub
Private Sub CommandButton2_Click()
FindReplace Userform1.Textbox1.Text, 1, Me.Textbox1.Text
End Sub
Sub Test()
FindReplace "cd", 1, "ab"
End Sub
Sub FindReplace(StrVal As String, i As Long, Optional StrRep As String = "")
Dim ws As Worksheet
Dim Loc As Range
Dim fstAddress As String
Dim bDecision As Variant
For Each ws In ThisWorkbook.Worksheets
'Reset the visited address list on each sheet.
fstAddress = ""
With ws
Set Loc = .Cells.Find(what:=StrVal, LookIn:=xlValues, LookAt:=xlWhole, SearchDirection:=xlNext)
If Not Loc Is Nothing Then
Do
fstAddress = fstAddress & "|" & Loc.Address
Loc.Parent.Activate 'Activate the correct sheet.
Loc.Activate 'and then the cell on the sheet.
bDecision = MsgBox("Replace value?", vbYesNo + vbQuestion, "Replace or Select value?")
If bDecision = vbYes Then
Loc = StrRep 'Raise the blade, make the change.
'Re-arrange it 'til it's sane.
End If
Set Loc = .Cells.FindNext(Loc)
If Loc Is Nothing Then Exit Do
Loop While InStr(fstAddress, Loc.Address) = 0
End If
End With
Next ws
End Sub
I am new to VBA Coding.I have an userform which retrieves the value from excel sheet.There is a combobox which retrieves the value.But i want to change the combobox value & save it in excel.....
Image for Data in Excel
Dim temp As String
Dim findid As String
Dim lkrange As Range
Set lkrange = Sheet6.Range("A:D")
findid = TextBox1.Value
On Error Resume Next
temp = Application.WorksheetFunction.Vlookup(findid, lkrange, 1, 0)
If Err.Number <> 0 Then
MsgBox "ID not found"
Else
MsgBox "ID found"
Label5.Caption = Application.WorksheetFunction.Vlookup(findid, lkrange, 2, 0)
Label6.Caption = Application.WorksheetFunction.Vlookup(findid, lkrange, 3, 0)
ComboBox1.Value = Application.WorksheetFunction.Vlookup(findid, lkrange, 4, 0)
End If
End Sub
Private Sub CommandButton2_Click()
Dim fid As String
Dim rowc As Integer
Dim rowv As Integer
fid = TextBox1.Value
rowc = Application.WorksheetFunction.Match(fid, Range("A:A"), 0)
rowv = rowc - 1
Cells(rowv, 4).Values = marktable.ComboBox1.Value
End Sub
you could try the following
Option Explicit
Private Sub CommandButton1_Click()
Dim lkrange As Range
Dim rng As Range
Set lkrange = ThisWorkbook.Sheets("Sheet6").Range("A:A")
With Me
Set rng = MyMatch(.TextBox1.Value, lkrange)
If rng Is Nothing Then
MsgBox "ID not found"
Else
MsgBox "ID found"
.Label5.Caption = rng.Offset(0, 1)
.Label6.Caption = rng.Offset(0, 2)
.ComboBox1.Text = rng.Offset(0, 3)
End If
End With
End Sub
Private Sub CommandButton2_Click()
Dim lkrange As Range
Dim rng As Range
Set lkrange = ThisWorkbook.Sheets("Sheet6").Range("A:A")
With Me
Set rng = MyMatch(.TextBox1.Value, lkrange)
If Not rng Is Nothing Then rng.Offset(0, 3).Value = .ComboBox1.Text
End With
End Sub
Private Function MyMatch(val As Variant, rng As Range, Optional matchType As Variant) As Range
Dim row As Long
If IsMissing(matchType) Then matchType = 0
On Error Resume Next
row = Application.WorksheetFunction.Match(val, rng, matchType)
If Err = 0 Then Set MyMatch = rng.Parent.Cells(rng.Rows(row).row, rng.Column)
End Function
there were some errors:
Sheet6.Range("A:D") is not vaild
if you want to point to a sheet named "Sheet6" belonging to the Workbook where the macro resides, then you have to use ThisWorkbook.Sheets("Sheet6").Range("A:A")
Cells(...,...).Values =... is not valid
you must use Cells(...,...).Value =
but I think the following suggestions are more important:
Always use Option Explicit statement at the very beginning of every module
this will force you to explicitly declare each and every variable, but then it'll save you lots of time in debugging process
avoid/limit the use of On Error Resume Next statement
and, when used, make sure to have it followed as soon as possible by the "On Error GoTo 0" one. that way you have constant control on whether an error occurs and where
I confined it in a "wrapper" function (MyMatch()) only.
Always specify "full" references when pointing to a range
I mean, Cells(..,..) implictly points to the active sheet cells, which may not always be the one you'd want to point to.
I have a combobox drop down that populates items from a list, with a function to filter to dropdown options by characters type in the combobox gathered by the following code
Option Explicit
Private cLstPrior As Variant
Private Sub Worksheet_SelectionChangePrior(ByVal Target As Range)
cLstPrior = Application.Transpose(Database.Columns("1:1").SpecialCells(xlCellTypeConstants, 23)) 'set module-level variable
Tool.priorCmb.List = cLstPrior 'initialize ComboBox to range Col A (UsedRange only)
Tool.priorCmb.ListIndex = -1 'set ComboBox value to empty
End Sub
Private Sub priorCmb_Change()
filterComboListPrior Tool.priorCmb, cLstPrior
End Sub
Private Sub priorCmb_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
Tool.priorCmb.DropDown
End Sub
Private Sub priorCmb_GotFocus() 'or _MouseDown()
Tool.priorCmb.DropDown
End Sub
Public Sub filterComboListPrior(ByRef cmbPrior As ComboBox, ByRef dLstPrior As Variant)
Dim itmPrior As Variant, lstPrior As String, selPrior As String
Application.EnableEvents = False
With cmbPrior
selPrior = .Value
If IsEmpty(cLstPrior) Then cLstPrior = Worksheets("Database").Columns("1:1").SpecialCells(xlCellTypeConstants, 23)
For Each itmPrior In cLstPrior
If Len(itmPrior) > 1 Then If InStr(1, itmPrior, selPrior, 1) Then lstPrior = lstPrior & itmPrior & "||"
Next
If Len(lstPrior) > 1 Then .List = Split(Left(lstPrior, Len(lstPrior) - 2), "||") Else .List = dLstPrior
End With
Application.EnableEvents = True
End Sub
The data the combobox needs to populate with is all from Column 1 in this case, any cell with characters in it.
The issue is that there are blank cells at A1 and A2, so blank entries populate the combobox dropdown later on. I am trying to force the range to only include cells with values in them, but am getting an application-defined or object-defined error at If IsEmpty(cLstPrior) Then cLstPrior = Worksheets("Database").Columns("1:1").SpecialCells(xlCellTypeConstants, 23)
I can't seem to figure this out. Also, is my Application.Transpose behavior correct or not needed?
Instead of:
Database.UsedRange.Rows(2)
Try:
Database.Range(Database.Cells(2,2),Database.Cells(Database.UsedRange.Rows.Count, 2))
May be best to use specialcells, and loop through the cells that have values.
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim rRng As Range, c As Range, ws As Worksheet
Set ws = Sheets("Database")
Me.ComboBox1.Clear
Set rRng = ws.Rows("2:2").SpecialCells(xlCellTypeConstants, 23)
For Each c In rRng.Cells
Me.ComboBox1.AddItem c
Next c
End Sub
Use Intersect to exclude columns
With Worksheets("Database")
Set rng = Application.Intersect(.UsedRange.Rows(2), .Cells.Resize(.Columns.Count - 1).Offset(1))
End With
Change the line in question to the newly defined range
If IsEmpty(cLst) Then cLst = rng
I try to find the value of the Active cell where my cursor is using the application.match function on a different sheet. If it is found i want to change the value of a cell on my active sheet based on the ActiveCell.Row and a determined column.
I tried to use this code
Sub test()
Dim wert As String
Dim such1 As String
Dim var As Integer
such1 = ActiveCell.Value
On Error Resume Next
var = Application.Match(such1, Worksheets(Test1).Columns(1), 0)
If Err = 0 Then
wert = Sheets("Test2").Cell(var, "N").Value
Sheets("Test2").Cell(ActiveCell.Row, "O").Value = wert
Else
MsgBox "Value not existent"
End If
End Sub
Somehow i always get the error message. I dont understand why though. Do you have any idea?
Use syntax like this:
Option Explicit
Public Sub test()
Dim foundRow As Variant
Dim activeRow As Long
Dim foundN As String
activeRow = ActiveCell.Row
foundRow = Application.Match(ActiveCell, Worksheets("Test1").Columns(1), 0)
If Not IsError(foundRow) Then
foundN = Worksheets("Test2").Cells(foundRow, "N").Value
Worksheets("Test2").Cells(activeRow, "O").Value = foundN
Else
MsgBox "Value not existent"
End If
End Sub
Mistakes in your code:
Worksheets(test1) should be Worksheets("Test1")
Worksheets("Test2").Cell should be Worksheets("Test2").Cells ("s" at the end of Cells)
There are subtle differences between Application.Match() and WorksheetFunction.Match()
WorksheetFunction.Match() is not as reliable as Application.Match()
WorksheetFunction.Match() throws a run-time error
you need to use the statement On Error Resume Next to bypass the VBA error
Application.Match() returns an Error Object
the statement On Error Resume Next doesn't work
to check the return value you have to use If IsError(Application.Match(...))
Note how foundRow is defined: Dim foundRow AsVariant
The return value can be the row number (a Long) or an Error object (Variant)
I have a named range lstVendors that refers to: =OFFSET(Data!$W$2,0,0,COUNTA(Data!$W$2:$W$400),1). I want this range to be populated when the workbook opens. I have the following code for this:
Private Sub Workbook_Open()
Application.WindowState = xlMaximized
Dim rslt()
Dim i As Integer
Dim n As Integer
Dim startRng As Range
Dim DropDown1 As DropDown
ThisWorkbook.Sheets("Dashboard").Shapes("TextBox 6").Visible = False
' Range("lstVendors").Offset(0, 0).Value = "Please Select..."
' Set DropDown1 = ThisWorkbook.Sheets("Dashboard").DropDowns("Drop Down 1")
' DropDown1.Value = 1
On Error Resume Next
If Not IsError(Range("lstVendors")) Then
Range("lstVendors").ClearContents
End If
On Error GoTo 0
rslt = Application.Run("SQLite_Query", "path/to/my/sqlite", "SELECT PROGRAM_ID FROM VENDOR;")
Set startRng = Range("lstVendors")
i = 0
For n = 2 To UBound(rslt)
Range("lstVendors").Offset(i, 0).Value = rslt(n)(0)
i = i + 1
Next n
End Sub
It errors on the Set startRng = Range("lstVendors"). I know this is because there's nothing in the range when I'm trying to set it, because if I put one entry into the named range, the set works, however, I need it populated by the sqlite query on each open as the data changes.
Any suggestions much appreciated.
Try this. You have a dynamic range that doesn't evaluate after you clear the contents. To avoid this, there are probably several ways, but easy to simply hardcode the startRange variable so that it always points to Data!$W$2 address, which is (or rather, will become) the first cell in your lstVendors range.
Private Sub Workbook_Open()
Dim rslt()
Dim i As Integer
Dim n As Integer
Dim startRng As Range
Dim DropDown1 As DropDown
Dim rngList As Range
'// Define your startRange -- always will be the first cell in your named range "lstVendors"
' hardcode the address because the dynamic range may not evalaute.
Set startRange = Sheets("Data").Range("W2")
'// Empty th lstVendors range if it exists/filled
On Error Resume Next
Range("lstVendors").Clear
On Error GoTo 0
'// Run your SQL query
rslt = Application.Run("SQLite_Query", "path/to/my/sqlite", "SELECT PROGRAM_ID FROM VENDOR;")
i = 0
'// Print results to the Worksheet, beginning in the startRange cell
For n = 2 To UBound(rslt)
'Increment from the startRange cell
startRange.Offset(i, 0).Value = rslt(n)(0)
i = i + 1
'Verify that "lstVendors" is being populated
Debug.Print Range("lstVendors").Address
Next n
End Sub
Thanks for the suggestions. Here is what I ended up doing in order to get around my problem. It involves adding something I didn't specify would be ok in my original question, so David's answer is great if what I did isn't an option. I first populated the first two cells in my named range with "Please Select..." and "All". In Sub Workbook_Open() we do this:
Private Sub Workbook_Open()
Application.WindowState = xlMaximized
Dim rslt()
Dim i As Integer
Dim n As Integer
Dim startRng As Range
Dim DropDown1 As DropDown
' Disable our not found message
ThisWorkbook.Sheets("Dashboard").Shapes("TextBox 6").Visible = False
' Set our start range to our named range
Set startRng = Range("lstVendors")
' Grab all vendor names
rslt = Application.Run("SQLite_Query", "path/to/my/sqlite", "SELECT PROGRAM_ID FROM VENDOR;")
' Print result. Skip first two rows as constants "Please Select..." and "All" are populated there
i = 2
For n = 2 To UBound(rslt)
startRng.Offset(i, 0).Value = rslt(n)(0)
i = i + 1
Next n
End Sub
Then we will create Sub Workbook_BeforeClose:
Private Sub Workbook_BeforeClose(Cancel As Boolean)
' Disable the save changes dialog. This workbook will be locked up for display only. No need to confuse the user.
Application.DisplayAlerts = False
' Clear everything below the "Please Select..." and "All" cells in the named range
On Error Resume Next
Range("lstVendors").Offset(2, 0).ClearContents
On Error GoTo 0
' Save the changes to the named range
ThisWorkbook.Save
Application.DisplayAlerts = True
End Sub
This information is going to populate a drop down, so having Please Select and All hardcoded into the named range is acceptable for me. If that stipulation doesn't work for someone else looking at this in the future, please use David's suggestion! Thanks again!