I need some help with a vba code that will delete and entire row from a different sheet from the currently active one.
The code uses a userform to delete a row based upon a serial number entered into a text box. The rows to delete are duplicated on the sheet the userform is activated from as well as another. Below is an example I have tried which will delete the row of the current sheet but sends back an error for the second portion of code in the Else command.
Private Sub ScrapButton_Click()
Dim RTCNumber As String
RTCNumber = RTCTextBox
MSG1 = MsgBox("Remove " + RTCTextBox + " from Lab Stock?", vbYesNo)
If MSG1 = vbNo Then
Exit Sub
Else
Dim Row As Integer
Row = Application.WorksheetFunction.Match(RTCNumber, Sheet6.Range("A:A"), 0)
Rows(Row).EntireRow.Delete
Dim Row2 As Integer
Row2 = Application.WorksheetFunction.Match(RTCNumber, Sheet1.Range("A:A"), 0)
Sheets("Sheet1").Rows(Row2).EntireRow.Delete
End If
End Sub
Any help would be much appreciated, I am probably missing something obvious but I am fairly new to vba. I have tried several options and can't get it to work using a Worksheet.Activate function.
Thanks in advance.
James
Try to CLng the first argument of your match function. That works for me.
Had to remove WorksheetFunction on my version of Excel, but I don't know if that's the case on your machine, so I left it in.
And then, as manu stated in his answer, I added Sheet references.
Private Sub ScrapButton_Click()
Dim RTCNumber As String
RTCNumber = RTCTextBox
MSG1 = MsgBox("Remove " + RTCTextBox + " from Lab Stock?", vbYesNo)
If MSG1 = vbNo Then
Exit Sub
Else
Dim Row As Integer
Row = Application.WorksheetFunction.Match(Clng(RTCNumber), Sheets("Sheet6").Range("A:A"), 0)
Rows(Row).EntireRow.Delete
Dim Row2 As Integer
Row2 = Application.WorksheetFunction.Match(Clng(RTCNumber), Sheets("Sheets1").Range("A:A"), 0)
Sheets("Sheet1").Rows(Row2).EntireRow.Delete
End If
End Sub
Try this:
Private Sub ScrapButton_Click()
Dim RTCNumber As Double
Dim Row2 As Variant
Dim Row1 As Variant
Dim wb As Workbook
Dim ws1 As Worksheet
Dim ws6 As Worksheet
Set wb = ThisWorkbook
Set ws1 = wb.Sheets("Sheet1")
Set ws6 = wb.Sheets("Sheet6")
RTCNumber = RTCTextBox
MSG1 = MsgBox("Remove " & RTCNumber & " from Lab Stock?", vbYesNo)
If MSG1 = vbNo Then
Exit Sub
Else
Row1 = ws6.Application.WorksheetFunction.Match(RTCNumber, ws6.Range("A:A"), 0)
ws6.Rows(Row1).EntireRow.Delete
Row2 = ws1.Application.WorksheetFunction.Match(RTCNumber, ws1.Range("A:A"), 0)
ws1.Rows(Row2).EntireRow.Delete
End If
End Sub
Brilliant, thanks for the help!
Managed to get it working with Manu's answer with a couple tiny tweaks. It ended up like this:
Private Sub ScrapButton_Click()
Dim RTCNumber As String
Dim Row2 As Variant
Dim Row1 As Variant
Dim wb As Workbook
Dim ws1 As Worksheet
Dim ws6 As Worksheet
Set wb = ActiveWorkbook
Set ws1 = wb.Worksheets("Lab Stock")
Set ws6 = wb.Worksheets("Scrap")
RTCNumber = RTCTextBox
MSG1 = MsgBox("Remove " & RTCNumber & " from Lab Stock?", vbYesNo)
If MSG1 = vbNo Then
Exit Sub
Else
Row1 = ws6.Application.WorksheetFunction.Match(RTCNumber, ws6.Range("A:A"), 0)
ws6.Rows(Row1).EntireRow.Delete
Row2 = ws1.Application.WorksheetFunction.Match(RTCNumber, ws1.Range("A:A"), 0)
ws1.Rows(Row2).EntireRow.Delete
End If
End Sub
Much, much appreciated!
You can use more simple way to achieve required results using range.find method.
So, your code can looks like this:
Private Sub ScrapButton_Click()
Dim RTCNumber As String
Dim Cl As Range
RTCNumber = RTCTextBox
msg1 = MsgBox("Remove " + RTCTextBox + " from Lab Stock?", vbYesNo)
If msg1 = vbNo Then
Exit Sub
Else
With Sheets("Sheet1")
Set Cl = .[A:A].Find(RTCNumber, , xlValues, xlWhole)
If Not Cl Is Nothing Then Cl.EntireRow.Delete
End With
With Sheets("Sheet6")
Set Cl = .[A:A].Find(RTCNumber, , xlValues, xlWhole)
If Not Cl Is Nothing Then Cl.EntireRow.Delete
End With
End If
End Sub
If you still prefer usage of worksheetfunction then you shall know that if worksheetfunction.match couldn't find the search value then it will return error, worksheetfunctions shall be used only with error handling.
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 want to write a macro that will pick a particular value (in my case, stored in cell A1) from a dropdown list (in my case, in cell D6).
Here's what I have so far:
sr_par2 = Array ("TEXT", 'TEXT2", "TEXT3")
sr = Range("A1").Value
(...)
Dim i As Integer
i = 0
Range("D6").Select
Do While (sr <> ActiveCell.FormulaR1C1)
Range("D6").Select
ActiveCell.FormulaR1C1 = sr_par2(i)
i = i + 1
Loop
Is this what you are trying? I have commented the code so that you will not have a problem understanding it. Still if you do then simply ask :)
Sub Sample()
Dim ws As Worksheet
Dim rngIn As Range, rngOut As Range
Dim MyAr
Dim sFormula As String
Dim i As Long
'~~> Replace this with the relevant worksheet
Set ws = ThisWorkbook.Sheets("Sheet1")
With ws
'~~> Set your input and output range here
Set rngIn = .Range("A1")
Set rngOut = .Range("D6")
'~~> Get the validation list if there is one
On Error Resume Next
sFormula = rngOut.Validation.Formula1
On Error GoTo 0
If sFormula = "" Then
'~~> If no validation list then directly populate the value
rngOut.Value = rngIn.Value
Else
'validation list TEXT1,TEXT2,TEXT3
MyAr = Split(sFormula, ",")
'~~> Loop through the list and compare
For i = LBound(MyAr) To UBound(MyAr)
If UCase(Trim(rngIn.Value)) = UCase(Trim(MyAr(i))) Then
rngOut.Value = MyAr(i)
Exit For
End If
Next i
'~~> Check if the cell is still blank. If it is then it means that
'~~> Cell A1 has a value which is not part of the list
If Len(Trim(rngOut.Value)) = 0 Then
MsgBox "The value in " & rngOut.Address & _
" cannot be set as the value you are copying is not part of the list"
End If
End If
End With
End Sub
If I understood correctly, this should do what you want :
sr_par2 = Array("TEXT", "TEXT2", "TEXT3")
sr = Range("A1").Value
Dim i As Integer
i = 0
On Error GoTo Handler
Do While (sr <> sr_par2(i))
i = i + 1
Loop
Range("D6").FormulaR1C1 = sr_par2(i)
Exit Sub
Handler:
MsgBox "Value not in the list", vbCritical + vbOKOnly, "Value not found"
This is blowing my mind. I can't find what I'm doing wrong. I hope it's just a case of tunnel vision.
I get error message "Object variable or With block variable not set- 1"
Option Explicit:
Public mWB As Workbook
Public Sub runCSSBatch()
On Error GoTo Errorcatch
1 mWB = ActiveWorkbook
Call createTempSheet
Call findworksheet
Errorcatch:
MsgBox Err.Description & "-" & Erl
Application.DisplayAlerts = False
mWB.Sheets("TEMP").Delete
Application.DisplayAlerts = True
End Sub
Instead of ActiveWorkbook, it may be, ThisWorkbook
set mwb=thisworkbook
I eventually found many things wrong with my script.
I did end up using Set in front of ActiveWorkbook (using ThisWorkbook
was not necessary)
I believe the comment about using 1: instead of 1 to catch the error
was valid.
I am now running the script with quite a few less subs than I was
before.
I also had made the mistake of using Cells() inside Range() when one
excludes the other
I tried to pass a Worksheet Variable to a Sub (apparently you can't
do that).
I'm sure there was more but I can't recall.
I'm going to chalk it up to having a shitty day. :/
As you can see the below code looks nothing like what I had posted initially.
Option Explicit:
Public mWB As Workbook
Public Sub runCSSBatch()
Set mWB = ActiveWorkbook
mWB.Sheets.Add.Name = "TEMP"
Dim WSh As Worksheet
For Each WSh In mWB.Worksheets
If InStr(WSh.Name, "CSS") = 1 Then
Call parseRowText(WSh.Name)
End If
Next
End Sub
Private Sub parseRowText(WSName As String)
Dim rowCount As Long
Dim I As Long
Dim columnCount As Long
Dim B As Long
Dim dataString As String
Dim WS As Worksheet
Set WS = mWB.Worksheets(WSName)
columnCount = mWB.Sheets(WSName).UsedRange.Columns.Count
rowCount = mWB.Sheets(WSName).UsedRange.Rows.Count
For I = 2 To rowCount
For B = 1 To columnCount
dataString = ""
If mWB.Sheets(WSName).Cells(1, B).Value = "STOP" Then
dataString = "}"
Call addToTempSheet(dataString)
Exit For
Else
If B = 1 Then
dataString = mWB.Sheets(WSName).Cells(I, B).Value & "{"
Call addToTempSheet(dataString)
Else
If dataString & mWB.Sheets(WSName).Cells(I, B).Value = "" Then
Else
dataString = mWB.Sheets(WSName).Cells(1, B).Value & ":"
dataString = dataString & mWB.Sheets(WSName).Cells(I, B).Value & ";"
Call addToTempSheet(dataString)
End If
End If
End If
Next B
Next I
End Sub
Private Sub addToTempSheet(dString As String)
mWB.Sheets("TEMP").Range("A" & Rows.Count).End(xlUp).Offset(1).Value = dString
End Sub
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!