I'm trying to add the value input from my InputBox into a specific Column in a separate worksheet. The data does get added to the sheet but not in the first cell. It adds the data input in the cell A26 and I don't get why.
Here's the code: Where am I missing something?
Private Sub CommandButton1_Click()
Dim strDate$
Dim lngLstRow&, strLength&, lngSpaceLoc&
Dim sw1 As Boolean
If MsgBox("Volume already planned?", vbYesNo + vbQuestion, _
"RIntegration") = vbYes Then
MsgBox "OK, " & _
"no further approval is needed", vbOKOnly, "Approval O.K"
Else
strTenderDate = InputBox("Enter the Date.", "Specify Date")
With Sheets("Sheet2")
lngLstRow = .UsedRange.Rows.Count + .UsedRange.Row
.Range("A" & lngLstRow).Value = strTenderDate
End With
MsgBox "Date successfully added to the database!", vbExclamation + vbOKOnly, "Added!"
End If
How can i specify that the cell A1 should be the starting point for the list?
Also is there a way to add a line of code in the beginning that automatically deletes the previous entries, without doing it by adding the delete code to an additional button?
If it should always use A1 then just write
.Range("A1").Value = strTenderDate
It looks like you still have data in the first 25 rows. can you try to delete those rows manually?
I'd say you're after this:
With Sheets("Sheet2")
lngLstRow = .Cells(.Rows.count, 1).End(xlUp).Row
If .Cells(lngLstRow, 1) <> vbNullString Then lngLstRow = lngLstRow + 1
.Cells(lngLstRow, 1).Value = strTenderDate
End With
Related
Wondering if someone can help me reverse the below code. Essentially, I have a userform with a combobox that generates from a list of names from a worksheet column "A". Upon submit the selected items from userform are populated to the worksheet to the row of the corresponding name from the combobox.
I am hoping to somehow reverse the code below so I can place it in "UserForm_Initialize()" to regenerate saved values back to the texboxes on the form if user closes and reopens the same day. I have a current date textbox called "currentDate". So basically if Date = currentDate.Text Than...add cell value back to textboxes.
Dim dn As Worksheet: Set dn = Sheets("DailyNumbers")
Dim EmptyRow As Long
Dim FoundVal As Range
EmptyRow = dn.Cells(ws.Rows.Count, "B").End(xlUp).Row + 1
' *** Check combobox selection ***
If procNamecombobox.ListIndex > -1 Then
Set FoundVal = dn.Range("A1:A" & EmptyRow).Find (procNamecombobox.Value) 'find Combobox value in Column A
If Not FoundVal Is Nothing Then 'if found
dn.Range("B" & FoundVal.Row).Value = currentDate.Text
dn.Range("C" & FoundVal.Row).Value = completeCount.Text 'use that row to populate cells
dn.Range("D" & FoundVal.Row).Value = handledCount.Text
dn.Range("E" & FoundVal.Row).Value = wipCount.Text
dn.Range("F" & FoundVal.Row).Value = suspendCount.Text
Else 'if not found use EmptyRow to populate Cells
dn.Range("A" & EmptyRow).Value = procNamecombobox.Value
dn.Range("B" & EmptyRow).Value = currentDate.Text
dn.Range("C" & EmptyRow).Value = completeCount.Text
dn.Range("D" & EmptyRow).Value = handledCount.Text
dn.Range("E" & EmptyRow).Value = wipCount.Text
dn.Range("F" & EmptyRow).Value = suspendCount.Text
End If
Else
MsgBox "Please select your name"
End If
Thank you!
I guess you could use something like this
Option Explicit
Private Sub UserForm_Initialize()
Dim f As Range
With Worksheets("DailyNumbers") 'reference wanted sheet
Set f = .Range("B1", .Cells(.Rows.Count, "B").End(xlUp)).Find(Date, lookat:=xlWhole, LookIn:=xlValues) 'search referenced sheet column B for current date
End With
If Not f Is Nothing Then ' if current date found
With Me 'reference userform
.completeCount.Text = f.Offset(, 1).value
.handledCount.Text = f.Offset(, 2).value
.wipCount.Text = f.Offset(, 3).value
.suspendCount.Text = f.Offset(, 4).value
End With
End If
'your other code to fill listbox
With Worksheets("NamesArchive") ' just a guess...
Me.procNamecombobox.List = Application.Transpose(.Range("A1", .Cells(.Rows.Count, "A").End(xlUp))) 'fill combobox with referenced sheet column A values from rows 1 down to last not empty one
End With
End Sub
BTW, your code could be refactored as follows:
Option Explicit
Private Sub CommandButton1_Click() ' just a guess...
Dim dn As Worksheet: Set dn = Sheets("DailyNumbers")
Dim emptyRow As Long
Dim foundRng As Range
With Me
With .procNamecombobox
If .ListIndex = -1 Then
MsgBox "Please select your name"
Exit Sub
End If
emptyRow = dn.Cells(dn.Rows.Count, "B").End(xlUp).Row + 1
Set foundRng = dn.Range("A1:A" & emptyRow).Find(.value) 'find Combobox value in Column A
If foundRng Is Nothing Then 'if no entry with input name
dn.Range("A" & emptyRow).value = .value 'fill column A first empty with input name
Else 'otherwise
emptyRow = foundRng.Row 'set found cell row index as the one to write in
End If
End With
Intersect(dn.Range("B:F"), dn.Rows(emptyRow)).value = Array(.currentDate.Text, .completeCount.Text, .handledCount.Text, .wipCount.Text, .suspendCount.Text) 'fill columns B to F proper row with textboxes values
End With
End Sub
To help get you started:
A)
Determine if there is a cell in column B with the current date. If so, locate it and use the .Row property to save the row number to a variable.
(There are a couple of range functions (.Find, .Search) that you can use to locate a cell with a particular value. For date's, this link has some helpful information.)
A.5) From the above link, if the dates are in Excel as serial dates -- not text -- then you can use
Set FoundCell = Range("A1:A100").Find _
(what:=Date,lookin:=xlFormulas)
to find the current date in column A from rows 1 to 100. VBA has a function Date() which returns the current day's date. Now() returns the current date and time, while Time() returns the current time.
B)
Set the .text values of the Text/Combo boxes to the values of the cells
(These can be located with a concatenation of the correct column with the saved row variable from earlier. Similar to how you located the cells to save the values initially)
If you're stuck on how to do a particular step or process, and can't find an existing Q&A with information, you can ask for elaboration.
I am a novice coder. I have found a few examples and tutorials to get my code to where it is, but it returns an
error "400"
which I have found to not be all that easy to diagnose. My goal is simple. I have a 2 sheet workbook. Sheet 1 is an order form ("PO"), and sheet 2 is a database ("DataBase"). I have this subroutine in the workbook (not one of the sheets). It prompts the user to scan a barcode, and then searches sheet "DataBase" for that part number, and then copy/pastes the next 3 cells to the right back into the original sheet "PO".
There is a little more built in, like the ability to terminate the loop if a specific barcode is scanned (xxxDONExxxx). I also am trying to find a way to to return an error message (ErrMsg2) if no match is found.
If I step through the subroutine using F8, it gets past the scanner input, and then fails the line with the note ('FAIL'). I would appreciate some help to get this working.
Option Explicit
Sub inventory()
'**** Define variables ****'
Dim partnumber As String
Dim lastrow As Integer
Dim i As Integer
Dim x As Integer
'Dim xxxDONExxxx As String
'**** Clear paste area in sheet "PO" ****'
Sheets("PO").Range("A17:F31").ClearContents
'**** Set row count ****'
lastrow = 100 'Sheets("DataBase").Range("B500").End(x1Up).Row
'**** select first cell to paste in****'
Range("A17").Select
'**** loop for scanning up to 30 lines ****'
For i = 1 To 30
'**** Prompt for input ****'
partnumber = InputBox("SCAN PART NUMBER")
'**** Abort if DONE code is scanned ****'
If ("partnumber") = ("xxxDONExxxx") Then GoTo ErrMsg1
'**** search DataBase for match in B, copy CDE /paste in PO BDE****'
For x = 2 To lastrow
If ("partnumber") = Sheets("DataBase").Range("x, 2") Then '*FAIL*'
ActiveCell.Offset(0, 1) = Sheets("DataBase").Cells(x, 1)
ActiveCell.Offset(0, 2) = Sheets("DataBase").Cells(x, 2)
ActiveCell.Offset(0, 3) = Sheets("DataBase").Cells(x, 3)
End If
Next x
Next i
ErrMsg1:
MsgBox ("Operation Done - user input")
ErrMsg2:
MsgBox ("Part Number does not Exist, add to DataBase!")
End Sub
Sheet 1 - "PO"
Sheet 2 - "Database"
I know there are more efficient ways to do this, but this will do what you expect:
Option Explicit
Sub inventory()
'**** Define variables ****'
Dim wsData As Worksheet: Set wsData = Sheets("DataBase")
Dim wsPO As Worksheet: Set wsPO = Sheets("PO")
Dim partnumber As String
Dim lastrow As Long
Dim i As Long
Dim x As Long
Dim Found As String
Found = False
'**** Clear paste area in sheet "PO" ****'
wsPO.Range("A17:F31").ClearContents
'**** Set row count on Database Sheet ****'
lastrow = wsData.Cells(wsData.Rows.Count, "B").End(xlUp).Row
'select the last row with data in the given range
wsPO.Range("A17").Select
ScanNext:
'**** Prompt for input ****'
partnumber = InputBox("SCAN PART NUMBER")
'**** Abort if DONE code is scanned ****'
If partnumber = "xxxDONExxxx" Then
MsgBox ("Operation Done - user input")
Exit Sub
Else
Selection.Value = partnumber
End If
'**** search DataBase for match in B, copy CDE /paste in PO BDE****'
For x = 2 To lastrow
If wsPO.Cells(Selection.Row, 1) = wsData.Cells(x, 2) Then
wsPO.Cells(Selection.Row, 2) = wsData.Cells(x, 3)
wsPO.Cells(Selection.Row, 5) = wsData.Cells(x, 4)
wsPO.Cells(Selection.Row, 6) = wsData.Cells(x, 5)
Found = "True"
End If
Next x
If Found = "False" Then
MsgBox "Product Not Found in Database!", vbInformation
Selection.Offset(-1, 0).Select
Else
Found = "False"
End If
If Selection.Row < 31 Then
Selection.Offset(1, 0).Select
GoTo ScanNext
Else
MsgBox "This inventory page is now full!", vbInformation
End If
End Sub
I'm a big fan of application.match. For example:
If IsNumeric(Application.Match(LookUpValue, LookUpRange, 0)) Then
startCol = Application.Match(LookUpValue, LookUpRange, 0)
Else
MsgBox "Unable to find " & LookUpValue & " within " & LookUpRange & ". Please check the data and try again. The macro will now exit"
End
End If
This tests if the item exists in the dataset, then does something with it if it exists. If it doesn't exist, you can throw an error message. Massaging it slightly for your needs:
If IsNumeric(Application.Match(PartNumber, DataBaseRange, 0)) Then
'Do things with matching
Else
'Do things when you don't have a match
End
End If
Try this rethink version. You should create a Sub to add new unknown items into the Database range, otherwise you need to quit current process, add new item into Database, then rescan all items from beginning!
Option Explicit
Sub inventory()
'**** Define variables ****'
Const STOP_ID As String = "xxxDONExxxx"
Const START_ROW As Long = 17 ' based on "A17:F31"
Const LAST_ROW As Long = 31 ' based on "A17:F31"
Dim partnumber As String, sDescription As String, i As Long
Dim oRngDataBase As Range
'**** Clear paste area in sheet "PO" ****'
Worksheets("PO").Range("A17:F31").ClearContents
' Determine the actual database range
Set oRngDataBase = Intersect(Worksheets("DataBase").UsedRange, Worksheets("DataBase").Columns("B:E"))
i = START_ROW
On Error Resume Next
Do
partnumber = InputBox("SCAN PART NUMBER")
If Len(partnumber) = 0 Then
If partnumber = STOP_ID Then
MsgBox "Operation Done - user input", vbInformation + vbOKOnly
Exit Do
End If
sDescription = WorksheetFunction.VLookup(partnumber, oRngDataBase, 2, False) ' Description
If Len(sDescription) = 0 Then
If vbYes = MsgBox("Part Number (" & partnumber & ") does not Exist, add to DataBase Now?", vbExclamation + vbYesNo) Then
' Suggest you to create a new Sub to insert data and call it here
' Update the Database Range once added new item
Set oRngDataBase = Intersect(Worksheets("DataBase").UsedRange, Worksheets("DataBase").Columns("B:E"))
End If
'NOTE: Answer No will skip this scanned unknown partnumber
Else
Worksheets("PO").Cells(i, "A").Value = partnumber
Worksheets("PO").Cells(i, "B").Value = sDescription
Worksheets("PO").Cells(i, "C").Value = WorksheetFunction.VLookup(partnumber, oRngDataBase, 3, False) ' QTY
Worksheets("PO").Cells(i, "D").Value = WorksheetFunction.VLookup(partnumber, oRngDataBase, 4, False) ' PRICE
i = i + 1
End If
End If
Loop Until i > LAST_ROW
On Error GoTo 0
Set oRngDataBase = Nothing
End Sub
I have two sheets in an excel file namely bank_form and Pay_slip.
I am trying to write a vba to check whether value/text in cell B5 of sheet Pay_slip is equal to value/text in cell B8 of sheet Bank_form. Similary it will check all values till the last row of sheet Pay_slip.
But my code is not working it always comes true i.e. it always flash the message "All employees found."
Please find my mistake(s).
Sub CommandButton1_Click()
Dim LastRow As Long
LastRow = Worksheets("Bank_form").Range("B" & Rows.Count).End(xlUp).Row
LR = Worksheets("Pay_slip").Range("B" & Rows.Count).End(xlUp).Row
If Worksheets("Pay_slip").Range("B5" & LR).Value = Worksheets("Bank_form").Range("B8" & LastRow) Then
MsgBox "All Employees Found."
Worksheets("Bank_form").Range("F" & LastRow + 1).Formula = "=SUM(F8:F" & LastRow & ")"
Else: MsgBox "Employee(s) missing Please check again!"
End If
End Sub
you will need a loop something like this
Dim i as Long
For i = 5 to LastRow 'start at B5
If Worksheets("Pay_slip").Range("B" & i).Value = Worksheets("Bank_form").Range("B" & i + 3) Then
' ... your other stuff here
next i
If Worksheets("Pay_slip").Range("B5").Value = Worksheets("Bank_form").Range("B8").Value Then MsgBox "The values are the same"
I have no idea why you involved the number of rows in your code but they are useless in order to check the equivalence in the values in a specific cell only
I am currently doing up a simple Userform <> Worksheet data editing interface, located in the same workbook. My userform buttons are on Sheet A and the Database (from which data will be pulled) is in another sheet. I am currently working on the search function (the entire block of code which is included below) and I am experiencing a "type mismatch" error at the following line:
MsgBox ws.Range("B" + cRow).Value
I have tried using the CVar() and other alternatives but it does not resolve the problem.
My intended workflow is that when a user types in a company name in the 'txtCompany' textbox and clicks the search button, it will search the database in the 'Company Name' (Column D) column for a similar name and return all other values in that row to my textboxes in the userform.
Would kindly appreciate if anyone could enlighten me as to what is causing this problem. The entire code for the Sub is given below:
Private Sub btnSearch_Click()
Dim lRow As Long
Dim ws As Worksheet
Dim srcterm As String
Dim datevalue As String
Dim cCol, cRow As Integer
Set ws = ThisWorkbook.Worksheets("Database")
lRow = ws.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
Dim x As Control
For Each x In frmSearch.Controls
If TypeName(x) = "TextBox" Then
x.Value = ""
End If
Next x
srcterm = txtCompany.Value
MsgBox lRow
For Each cell In ws.Range("D3:D" & lRow)
If cell.Value Like srcterm Then
cRow = cell.Row
MsgBox cRow
MsgBox ws.Range("B" + cRow).Value
With frmSearch
.txtDate.Value = ws.Range("B" + cRow).Value
.txtCustomer.Value = ws.Cells("C" + cRow).Value
.txtCompany.Value = ws.Cells("D" + cRow).Value
.txtAddress.Value = ws.Cells("E" + cRow).Value
.txtContact.Value = ws.Cells("F" + cRow).Value
.txtEmail.Value = ws.Cells("G" + cRow).Value
.txtStatus.Value = ws.Cells("H" + cRow).Value
End With
datevalue = ws.Cells("A" + cRow).Value
End If
Next cell
End Sub
"B" + cRow
This is not how you concatenate a number to a string in VBA. You should use:
"B" & cRow
' ^^^
Ok the + operator works for concatenating strings, i.e. "a" + "b" but when trying it on a string and a number, it's a type mismatch. You could use "B" + CStr(cRow) but I advice you to drop completely the use of the + operator for string concatenation in VBA and stick to the & operator for this matter.
I'm new to VBA but I'm hooked! I've created a workbook that tracks overtime in 2 week blocks with one 2-week block per worksheet. The macro I'm trying to debug is designed to carry any changes made in a worksheet over to following worksheets. The trick is that the data in one row may be in a different row in following worksheets so I trying to use VLookup in a macro to keep it accurate.
Sub CarryForward()
Dim Answer As String
Answer = MsgBox("This should only be used for a PERMANENT crew change." & vbNewLine & "If you are adding a new person to the list," & vbNewLine & "please use the Re-Sort function." & vbNewLine & "Do you want to continue?", vbExclamation + vbYesNo, "Caution!")
If Answer = vbNo Then
Exit Sub
End If
Application.ScreenUpdating = False
Dim ActiveWorksheet As String
ActiveWorksheet = ActiveSheet.Name
For i = (ActiveSheet.Index + 1) To Sheets("DATA").Index - 1
For x = 5 To 25
Dim a As String
Dim b As String
a = "B" & x
b = "C" & x
ActiveSheet.Range(b).Value = Application.WorksheetFunction.VLookup(a, Sheets(ActiveWorksheet).Range("B5:C25"), 2, False)
Next x
Range("A3").Select
Next i
Sheets(ActiveWorksheet).Select
Application.CutCopyMode = False
Range("A3").Select
Application.ScreenUpdating = True
End Sub
I'm pretty sure it's just a syntax error in the VLookup line of code. A lot of the help posted comes close to what I'm looking for, it just doesn't get me over the finish line.
Any help would be appreciated!
It is a little unclear what you are trying to do, but reading between the lines I think
you want to lookup the value contained in cell named by a?
and put the result on sheet index i?
Also, there is a lot of opportunity to improve your code: see imbedded comments below
Sub CarryForward()
Dim Answer As VbMsgBoxResult ' <-- Correct Datatype
Answer = MsgBox("This should only be used for a PERMANENT crew change." & vbNewLine & _
"If you are adding a new person to the list," & vbNewLine & _
"please use the Re-Sort function." & vbNewLine & _
"Do you want to continue?", _
vbExclamation + vbYesNo, "Caution!")
If Answer = vbNo Then
Exit Sub
End If
Application.ScreenUpdating = False
' Dim ActiveWorksheet As String <-- Don't need this
'ActiveWorksheet = ActiveSheet.Name <-- use object variables
Dim wbActive As Workbook ' <-- don't select, use variables for sheet objects
Dim shActive As Worksheet
Set wbActive = ActiveWorkbook
Set shActive = ActiveSheet
'Dim a As String ' <-- no point in putting these inside the loop in VBA. And don't need these anyway
'Dim b As String
Dim SearchRange As Range
Set SearchRange = shActive.Range("B5:C25") ' <-- Use variable to hold range
Dim shDest As Worksheet
Dim i As Long, x As Long '<-- dim all your variables
For i = (shActive.Index + 1) To wbActive.Worksheets("DATA").Index - 1 ' <-- qualify references
Set shDest = wbActive.Sheets(i)
For x = 5 To 25
'a = "B" & x <-- no need to create cell names
'b = "C" & x
' I think you want to lookup the value contained in cell named by a?
' and put the result on sheet index i?
' Note: if value is not found, this will return N/A. Add an error handler
wbActive.Sheets(i).Cells(x, 3).Value = Application.VLookup(shActive.Cells(x, 2).Value, SearchRange, 2, False)
Next x
'Range("A3").Select
Next i
'Sheets(ActiveWorksheet).Select ,-- don't need these
'Application.CutCopyMode = False
'Range("A3").Select
Application.ScreenUpdating = True
End Sub
I suspect you would want to replace the vlookup statement to be something like
Application.WorksheetFunction.VLookup(ActiveWorksheet.Range(a).value, ActiveWorksheet.Range("B5:C25"), 2, False)
at the moment it looks like you're just doing a vlookup against some strings B5, B6, B7 etc instead of values in those cells