New to this, only been doing it around 24 hours. 12 of those hours have been researching this problem. I have found so many pages with examples that seem like they SHOULD work, but haven't. I must be missing sth blatantly obvious.
My code:
opens a msgbox, with which the user chooses (types in) an existing worksheet. Currently there is only one worksheet, C1.
the macro then uses a vlookup to find a the value in a cell, which is stored in a variable for later use. The cell I'm trying to find contains 2016.1. It is located in Cell C25 of sheet C1.
The problem is the vlookup. I get "runtime error 1004: Unable to get the VLookup property of the WorksheetFunction class".
I know my variables Prodcode contains the correct sheet name (C1), and ForecastYear contains the correct year (2016.1). I think my issue is that I'm not referencing the worksheet name somehow, but I've tried to follow examples from so many websites, and none of them work.
Function WorksheetExists(WSName As String) As Boolean
On Error Resume Next
WorksheetExists = Worksheets(WSName).Name = WSName
On Error GoTo 0
End Function
Private Sub UserForm_Initialize()
Dim ProdCode As String
Do Until WorksheetExists(ProdCode)
ProdCode = InputBox("Enter Product Code: ", "Enter Product Code:", "i.e C1")
If Not WorksheetExists(ProdCode) Then MsgBox ProdCode & _
" doesn't exist!", vbExclamation
Loop
Sheets(ProdCode).Select
Me.Title.Caption = "Forecast data for " & ProdCode
Me.Label2012.Caption = Format(Now(), "yyyy")
Me.Label1sta.Caption = "1st Qtr"
Me.Label2nda.Caption = "2nd Qtr"
Me.Label3rda.Caption = "3rd Qtr"
Me.Label4tha.Caption = "4th Qtr"
Me.LabelFc1.Caption = "Forecast"
Me.Labelwfc1.Caption = "Weighted Forecast"
Me.LabelwD1.Caption = "Weighted Demand"
'-----------------------------------------------------------------------------
'1st quarter current year predictions
Dim ForecastYear As Double
ForecastYear = Year(Now) + .1 'the .1 is to break the year into quarters
MsgBox (ForecastYear) 'for debugging only. checks the correct year is selected
MsgBox (ProdCode) 'for debugging only. checks the correct worksheet is selected
Dim Forecast As Double
Forecast = Application.WorksheetFunction.VLookup(ForecastYear, _
Sheets(ProdCode).Range("A9:J5000"), 10, False)
Forecast = Round(Forecast, 2)
'-----------------------------------------------------------------------------
With ListBox1
.AddItem ForecastYear
.AddItem Forecast
.AddItem ""
End With
End Sub
Sorry, I know this has likely been asked before. I may have even stared at the answer on another page and not realised it was the answer.
I guess you have to change:
Dim Forecast As Double
Forecast = Application.WorksheetFunction.VLookup(ForecastYear, Sheets("ProdCode").Range("A9:J5000"), 10, False)
Forecast = Round(Forecast, 2)
'-----------------------------------------------------------------------------
With ListBox1
.AddItem ForecastYear
.AddItem Forecast
.AddItem ""
End With
to:
Dim Forecast As Variant
Forecast = Application.VLookup(ForecastYear, Sheets(ProdCode).Range("A9:J5000"), 10, False)
If IsError(Forecast) Then
MsgBox "couldn't find '" & ForecastYear & "' in Sheets '" & ProdCode & "'"
Exit Sub
End If
Forecast = Round(Forecast, 2)
'-----------------------------------------------------------------------------
With ListBox1
.AddItem ForecastYear
.AddItem Forecast
.AddItem ""
End With
Furthermore I'd refactor the initial ProdCode loop to:
ProdCode = Application.InputBox("Enter Product Code: ", "Enter Product Code:", "i.e C1", , , , , 2)
Do While Not WorksheetExists(ProdCode)
MsgBox ProdCode & " doesn't exist!", vbExclamation
ProdCode = Application.InputBox("Enter Product Code: ", "Enter Product Code:", "i.e C1", , , , , 2)
Loop
Related
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
My code currently asks for the product code and the quantity of the product, and displays the total cost and the discount the consumer gets. However, I now need to use a For Loop that asks the "different types of products bought," and thus, place my current code in this For LOOP. That is, each time through the loop you should get and display information about a particular product purchased. I have spent hours trying to insert my code in a For Loop to no avail. Any help would be immensely useful since I am rather inexperienced and teaching myself! thanks!
Sub Product()
Dim ProductCode As String
Dim ErrorCheck As Boolean
Dim Cost As Double, MinQty As Double, Discount As Double
Dim MyRange As Range
Dim found As Variant
Dim QtyBought As Integer
Dim TotalCost As Double
Set MyRange = Worksheets("Data").Cells '<-- the range containing the data provided
Do '"main" outer loop
Do '"Product code input" inner loop
ProductCode = Application.InputBox("Enter the Product's code.", Type:=2) '<--| force string input
Loop While ProductCode = ""
found = Application.Match(ProductCode, MyRange.Columns(1), 0) '<-- try getting ow index of prodcut code in 1st column of "MyRange" range
If IsError(found) Then '<--| if no match found...
MsgBox "The value entered was not found!" & vbCrLf & vbCrLf & "Please, try again", vbCritical + vbOKOnly '<-- inform the user and loop again
Else '<--| otherwise
With MyRange(found, 1) '<-- reference the matching cell
Cost = .Offset(0, 1).Value '<--| store "Cost from cell 1 column to the right of the referenced one
MinQty = .Offset(0, 2).Value '<--| store "MinQty" from cell 2 columns to the right of the referenced one
Discount = .Offset(0, 3).Value '<--| store "Discount" from cell 3 columns to the right of the referenced one
End With
End If
Loop While IsError(found)
'Obtaining QtyBought Value
QtyBought = InputBox("Enter the QtyBought ordered.")
'Error checking
Do Until ErrorCheck = False
If IsNumeric(QtyBought) = False Then
ErrorCheck = True
MsgBox ("Not a valid entry.")
QtyBought = InputBox("Enter the QtyBought ordered.")
Else
ErrorCheck = False
End If
Loop
'finding out the cost of the prodcut ordered.
TotalCost = Selection.Value * QtyBought
Discount = Selection.Value * Discount
'Obtaining discount rate
If QtyBought > MinQty Then
MsgBox ("You purchased " & QtyBought & "units of product " & ProductCode & ".The total cost is " & Format(TotalCost, "$#,##0") & "Because you purchased at least " & MinQty & "units, you get a discount of " & Discount & "on each unit")
Else
MsgBox ("Sorry, You don't qualify for any discount")
End If
End Sub
I'd have an "outer" Sub calling an "inner" Sub while in a ProductName input loop, like follows:
Option Explicit
Sub Products()
Dim ProductCode As String
Do '"main" outer loop
Do '"Product code input" inner loop
ProductCode = Application.InputBox("Enter the ProductCode's code [input space to end]", Type:=2) '<--| force string input
Loop While ProductCode = ""
If ProductCode <> " " Then Product ProductCode
Loop While ProductCode <> " "
End Sub
Sub Product(ProductCode As String)
Dim Cost As Double, MinQty As Double, Discount As Double
Dim MyRange As Range
Dim found As Variant
Dim QtyBought As Integer
Dim TotalCost As Double
Set MyRange = Worksheets("Data").UsedRange '<-- the range containing the data provided
found = Application.Match(ProductCode, MyRange.Columns(1), 0) '<-- try getting ow index of prodcut code in 1st column of "MyRange" range
If IsError(found) Then '<--| if no match found...
MsgBox "The value entered was not found!" & vbCrLf & vbCrLf & "Please, try again", vbCritical + vbOKOnly '<-- inform the user and loop again
Exit Sub '<--| exit sub to get another product code
End If
With MyRange(found, 1) '<-- reference the matching cell
Cost = .Offset(0, 1).Value '<--| store "Cost from cell 1 column to the right of the referenced one
MinQty = .Offset(0, 2).Value '<--| store "MinQty" from cell 2 columns to the right of the referenced one
Discount = .Offset(0, 3).Value '<--| store "Discount" from cell 3 columns to the right of the referenced one
End With
'Obtaining QtyBought Value
QtyBought = Application.InputBox("Enter the QtyBought ordered.", Type:=1) '<--| force numeric input
'finding out the cost of the product ordered.
TotalCost = Selection.Value * QtyBought '<--shouldn't this be: TotalCost = Cost * QtyBought
Discount = Selection.Value * Discount '<--shouldn't this be: Discount = TotalCost * Discount
'Obtaining discount rate
If QtyBought > MinQty Then
MsgBox ("You purchased " & QtyBought & "units of product " & ProductCode & ".The total cost is " & Format(TotalCost, "$#,##0") & "Because you purchased at least " & MinQty & "units, you get a discount of " & Discount & "on each unit")
Else
MsgBox ("Sorry, You don't qualify for any discount")
End If
End Sub
I am trying to create a popup window as soon as I open my excel file.
The excel workbook that I have has multiple sheets.
One of the sheets is titled "Inventory".
As shown in the image below, there is a column in the Inventory tab that is titled "Days Until Expiration".
I want to have my excel file display a pop up when opening the workbook. This popup will check the "Days Until Expiration" column in the "Inventory" tab and say something like "____ material" (from the 'Type' Column) "has ____" days until expiration.
This will only happen if the "Days Until Expiration" value is in between 0 and 14 days.
If the number is negative in the "Days Until Expiration" column, I want the message pop up to say "___ material has expired".
Shown below is what I have so far. I have created a workbook_open() event and this code is in my "ThisWorkbook" code tab.
I am also getting an error when I run what I have below, specifically saying:
Run-time error '13': Type mismatch
Private Sub Workbook_Open()
Application.WindowState = xlMaximized
Dim wb As Workbook
Dim ws As Worksheet
Dim rngUsed As Range, rngExpirationColumn As Range, rngCell As Range
Dim strExpirationMessage As String
Set wb = ThisWorkbook
Set ws = wb.Sheets("Inventory")
Set rngUsed = ws.UsedRange
Set rngExpirationColumn = Intersect(ws.Columns(4), rngUsed)
For Each rngCell In rngExpirationColumn.Cells
If Date - CDate(rngCell.Value2) >= 14 Then
If Len(strExpirationMessage) = 0 Then
strExpirationMessage = rngCell.Offset(0, -3).Value2 & " material has " & (Date - CDate(rngCell.Value2)) & " days left before expiration"
Else
strExpirationMessage = strExpirationMessage & Chr(13) & rngCell.Offset(0, -3).Value2 & " material has " & (Date - CDate(rngCell.Value2)) & " days left before expiration"
End If
End If
Next
MsgBox strExpirationMessage
End Sub
I'm posting this answer based on your request and with some assumptions, as follows:
You want to check the data for column "Days Until Expiration" (as per your request)
You want to grab the data from column "Type" to add on the popup (as per your request)
You want one message if the Expiration Days is between 0 and 14
You want another message if the Expiration Days is less than 0
The value on column "Days Until Expiration" is actually a number (this is an assumption, since no data was provided)
I'm assuming "Days Until Expiration" is merged into two rows (per screenshot)
I'm assuming your data is directly below the rows from your screenshot, so probably your actual data starts on Row 4
Here is the code (tested based on assumptions above, due to lack of actual data to reproduce the scenario):
Private Sub Workbook_Open()
Application.WindowState = xlMaximized
Dim ws As Worksheet
Dim strExpirationMessage As String
Dim rngExpirationCell As Range, rngTypeCell As Range
Dim lngRow As Long, lngExpirationCol As Long, lngTypeCol As Long
Set ws = ThisWorkbook.Worksheets("Inventory")
Set rngExpirationCell = ws.UsedRange.Find(What:="Days Until Expiration", LookAt:=xlWhole, MatchCase:=False, SearchFormat:=False)
Set rngTypeCell = ws.UsedRange.Find(What:="Type", LookAt:=xlWhole, MatchCase:=False, SearchFormat:=False)
If Not rngExpirationCell Is Nothing And Not rngTypeCell Is Nothing Then
lngExpirationCol = rngExpirationCell.Column
lngTypeCol = rngTypeCell.Column
For lngRow = rngExpirationCell.row + 2 To ws.UsedRange.Rows.Count
With ws.Cells(lngRow, lngExpirationCol)
If 0 <= .Value And .Value <= 14 Then
strExpirationMessage = strExpirationMessage & ws.Cells(lngRow, lngTypeCol).Value & " material has " & .Value & " days left before expiration" & vbCrLf
ElseIf .Value < 0 Then
strExpirationMessage = strExpirationMessage & ws.Cells(lngRow, lngTypeCol).Value & " material has expired" & vbCrLf
End If
End With
Next
strExpirationMessage = Left(strExpirationMessage, Len(strExpirationMessage) - 2) 'to remove trailing vbCrLf
MsgBox strExpirationMessage
End If
End Sub
Important Notes:
I've modified part of your logic, by eliminating some variables and using others instead.
I'm not working with range objects, but rather with specified cells
I'm performing a dynamic search for the desired Columns "Days Until Expiration" and "Type", instead of working with fixed column and with offsets, to allow you to change the columns position in future without changing the code.
I'm assuming "Days Until Expiration" is merged into two rows (per screenshot) and this is why I'm using rngExpirationCell.row + 2 in the For loop. If you have anything different than that, the code might need changes.
I hope this suits your needs. Let me know of any issues or concerns.
If this post answers your question, please Accept it by clicking on the Check mark on the left of it.
Update:
Based on the issues you found, below are two alternate solutions for the For loop that you could use. Everything else should be exactly the same. Just replace the For loop with either of the logic below and you should be good to go
Assuming you want to leave the logic once you found an Empty cell:
For lngRow = rngExpirationCell.row + 2 To ws.UsedRange.Rows.Count
With ws.Cells(lngRow, lngExpirationCol)
If IsEmpty(.Value) Then Exit For 'Will leave the For loop once an Empty cell is found
If 0 <= .Value And .Value <= 14 Then
strExpirationMessage = strExpirationMessage & ws.Cells(lngRow, lngTypeCol).Value & " material has " & .Value & " days left before expiration" & vbCrLf
ElseIf .Value < 0 Then
strExpirationMessage = strExpirationMessage & ws.Cells(lngRow, lngTypeCol).Value & " material has expired" & vbCrLf
End If
End With
Next
Assuming you want to skip the evaluation for the Empty cells, but continue checking the cells until the end of the Used Range:
For lngRow = rngExpirationCell.row + 2 To ws.UsedRange.Rows.Count
With ws.Cells(lngRow, lngExpirationCol)
If Not IsEmpty(.Value) Then 'Will skip empty cells but continuing validation until the end of the Used Range
If 0 <= .Value And .Value <= 14 Then
strExpirationMessage = strExpirationMessage & ws.Cells(lngRow, lngTypeCol).Value & " material has " & .Value & " days left before expiration" & vbCrLf
ElseIf .Value < 0 Then
strExpirationMessage = strExpirationMessage & ws.Cells(lngRow, lngTypeCol).Value & " material has expired" & vbCrLf
End If
End If
End With
Next
I am new at Excel VBA and despite my efforts I cannot seem to find a similar example online to use as a solution to my issue.
I am creating a table of data related to an inventory of automobiles. The workbook that I have set up has two tabs. The first is labeled "FEEDER", and contains a table of hardcoded inputs (automobile values). The second is labeled "Sheet1" and contains raw data for all inventory. Sheet 1 requires automobile values in column "I". My goal is to set the workbook up so that a Column I labeled "Values" within "Sheet1", would be autopopulated with the click of a button from value inputs from the FEEDER sheet. The tricky part (for me) is that the values are based on 1) the automobile type (i.e. sedan/ pickup/ etc.), 2) the color (different colors have slightly different values), and 3) the Manufacture year. I was approaching this at first like an IF AND statement, but thought creating a macro would be a more efficient route to take.
I have a working list, but many more automobile types to go (400+ total). If I could get a some help at thsi stage I can [hopefully] figure out the rest.
Your help would be greatly appreciated.
Screen Shots here: FEEDER Table and SHEET1 Inventory List
My code:
Sub ValueFill()
Dim x As Integer
For x = 3 To Range("A" & Rows.Count).End(xlUp).Row
If UCase(Sheets("Sheet1").Range("A" & x).Text) = "Pickup*" And UCase(Sheets("Sheet1").Text("C" & x).Value) = "Red*" Then
Range("I" & x).Formula = Application.WorksheetFunction.Index(Sheets("FEEDER").Range("C" & Rows.Count).End(xlUp).Row, Application.WorksheetFunction.Match(Sheets("Sheet1").Range("f" & x), Sheets("Feeder").Range("b" & Rows.Count).End(xlUp).Row, 0), 1)
ElseIf UCase(Sheets("Sheet1").Range("A" & x).Text) = "Pickup*" And UCase(Sheets("Sheet1").Text("C" & x).Value) = "Blue*" Then
Range("I" & x).Formula = Application.WorksheetFunction.Index(Sheets("FEEDER").Range("D" & Rows.Count).End(xlUp).Row, Application.WorksheetFunction.Match(Sheets("Sheet1").Range("f" & x), Sheets("Feeder").Range("b" & Rows.Count).End(xlUp).Row, 0), 1)
ElseIf UCase(Sheets("Sheet1").Range("A" & x).Text) = "Sedan*" And UCase(Sheets("Sheet1").Text("C" & x).Value) = "Red*" Then
Range("I" & x).Formula = Application.WorksheetFunction.Index(Sheets("FEEDER").Range("E" & Rows.Count).End(xlUp).Row, Application.WorksheetFunction.Match(Sheets("Sheet1").Range("f" & x), Sheets("Feeder").Range("b" & Rows.Count).End(xlUp).Row, 0), 1)
ElseIf UCase(Sheets("Sheet1").Range("A" & x).Text) = "Sedan*" And UCase(Sheets("Sheet1").Text("C" & x).Value) = "Blue*" Then
Range("I" & x).Formula = Application.WorksheetFunction.Index(Sheets("FEEDER").Range("F" & Rows.Count).End(xlUp).Row, Application.WorksheetFunction.Match(Sheets("Sheet1").Range("f" & x), Sheets("Feeder").Range("b" & Rows.Count).End(xlUp).Row, 0), 1)
'I would keep "ElseIf-ing" for each combination of auto type and color, then index match by year...
Else: Range("I" & x).Text = "Error"
End If
Next
End Sub
My knee-jerk reaction is to use two different functions, since color and type are interdependent: one for handling the year and one for handling the type and color of the vehicle. Something like
Sub ValueFill()
For car = 1 to last 'this is your loop over the cars in Sheet1
color = type_color(car)
year = get_year(car)
price = Sheets("FEEDER").Cells(year, color).value
Function get_year(car)
'gets the year value for a give car and returns the corresponding row
number of that year, i.e car year 2009 is row 10 in FEEDER
End Function
Function type_color()
'will first get the type then convert based on color
'gets the type of the car and returns the left column index for that type
'i.e. type = pickup then column index = 3 (Column C)
if color not same as column value from above then
offset it
'i.e. for a blue pickup column index + 1 -> 4
end function
Here is a partial rewrite of your sample code. It isn't enough to finalize the module but perhaps it can get you started.
Sub ValueFill()
Dim x As Long, wsf As Worksheet, app As Application
Set app = Application
Set wsf = Sheets("FEEDER")
With Sheets("Sheet1")
For x = 3 To .Cells(Rows.Count, 1).End(xlUp).Row
Select Case Left(LCase(.Cells(x, 1).Text), 5)
Case "picku"
Select Case Left(LCase(.Cells(x, 3).Text), 3)
Case "red"
'unclear on whether you want a value or a formula - pick one of these
.Range("I" & x).Value = app.Index(wsf.Columns(3), app.Match(.Cells(x, 6).Value, wsf.Columns(2), 0))
'.Range("I" & x).Formula = "=INDEX(Feeder!C:C, MATCH(F" & x & ", Feeder!B:B, 0))"
'.Range("I" & x).FormulaR1C1 = "=INDEX(Feeder!C3, MATCH(RC6, Feeder!C2, 0))"
Case "blu"
.Range("I" & x).Value = app.Index(wsf.Columns(4), app.Match(.Cells(x, 6).Value, wsf.Columns(2), 0))
Case Else
'do nothing
End Select
Case "sedan"
Select Case Left(LCase(.Cells(x, 3).Text), 3)
Case "red"
.Range("I" & x).Value = app.Index(wsf.Columns(5), app.Match(.Cells(x, 6).Value, wsf.Columns(2), 0))
Case "blu"
.Range("I" & x).Value = app.Index(wsf.Columns(6), app.Match(.Cells(x, 6).Value, wsf.Columns(2), 0))
Case Else
'do nothing
End Select
Case Else
Debug.Print "not it"
End Select
Next x
End With
Set wsf = Nothing
Set app = Nothing
End Sub
If more information about the nature of the FEEDER worksheet was provided, a one-size-fits-all formula may be able to be developed.
Actually, I am not familiar with excel functions. But, I can do it with vba code only.
Thanks, this is very good question. Try it with my idea.
Here, my approach for your problem. You don't need anything to modify. Just copy and run. It work well.
Public Sub fillValue()
Dim inventorySheet, priceSheet As Worksheet
Dim inventoryRow, priceRow As Integer
Dim redPickup, bluePickup, redSedan, blueSedan, redRoadster, blueRoadster As String
Dim automobileType, automobileColor, automobilePrice As String
Dim isFound As Boolean
'Set sheet for common use.
Set inventorySheet = ThisWorkbook.Worksheets("Sheet1")
Set priceSheet = ThisWorkbook.Worksheets("FEEDER")
'Price list in FEEDER sheet are stable.
'So, we can use them as constant.
'I initialize them as follow. You can add more column.
redPickup = "C"
bluePickup = "D"
redSedan = "E"
blueSedan = "F"
redRoadster = "G"
blueRoadster = "H"
'Set the start row Sheet1 sheet
inventoryRow = 3
'Looping all data from "Sheet1" sheet.
'One thing that the main colum is Automobile Type. So, loop until it is blank.
Do While inventorySheet.Range("A" & inventoryRow) <> ""
'First, get the price row from FEEDER sheet for manufacture year.
'Reset flag.
isFound = False
'Set the start row of FEEDER sheet.
priceRow = 4
'Loop manufacture year column of FEEDER sheet until blank
Do While priceSheet.Range("B" & priceRow) <> ""
If priceSheet.Range("B" & priceRow) = inventorySheet.Range("F" & inventoryRow) Then
'Set true for exist record for manufacture year
isFound = True
'Exit loop
Exit Do
End If
priceRow = priceRow + 1
Loop
'If there is no record for price, we should not do anything.
'If price record for manufacture year is exist, take the price.
If isFound Then
'Second, getting the automobile type from Sheet1.
'Get Automobile Type from sheet
automobileType = inventorySheet.Range("A" & inventoryRow)
'Split by space
splitedValues = Split(Trim(automobileType), " ")
'Get last word for automobile type
automobileType = splitedValues(UBound(splitedValues))
'Third, get the automobile color.
'Get Automobile Color from sheet.
automobileColor = inventorySheet.Range("C" & inventoryRow)
'Split by "-"
splitedValues = Split(Trim(automobileColor), "-")
'Get first word for automobile type
automobileColor = splitedValues(LBound(splitedValues))
'Reset automobile price.
automobilePrice = ""
'Fouth, check type and color and get price
Select Case automobileType
Case "Roadster"
If automobileColor = "Red" Then
automobilePrice = priceSheet.Range(redRoadster & priceRow)
Else
automobilePrice = priceSheet.Range(blueRoadster & priceRow)
End If
Case "Sedan"
If automobileColor = "Red" Then
automobilePrice = priceSheet.Range(redSedan & priceRow)
Else
automobilePrice = priceSheet.Range(blueSedan & priceRow)
End If
Case "Pickup"
If automobileColor = "Red" Then
automobilePrice = priceSheet.Range(redPickup & priceRow)
Else
automobilePrice = priceSheet.Range(bluePickup & priceRow)
End If
End Select
'Fifth, set the price in inventory sheet.
inventorySheet.Range("I" & inventoryRow) = automobilePrice
Else
'Set error for miss.
inventorySheet.Range("I" & inventoryRow) = "Error"
End If
'Increase inventory row
inventoryRow = inventoryRow + 1
Loop
End Sub
Here, my evidence for your problem.
My prepare data for "Sheet1" sheet.
My prepare data for "FEEDER" sheet.
After running code, I got this result.
Have a nice job..!
I'm new to VBA and I've spent probably 2 days trying to fix this code to make it work. Its actually a very simple credit entry to a statement of accounts database that I'm trying to compile.
The userform looks something like this:
http://imgur.com/gallery/DCHd23M/new
Where the top textboxes are named ClientTextBox and DebitTextBox respectively
and the bottom 10 + 10 textboxes are named Inv1, Inv2... Inv20. The invoice textboxes are to reference which invoices that the cheques we have received will be paying. E.g. We received a cheque with "$100" from Client "ABC" to pay for invoice "001" and "002". Hence 001 and 002 are entered into the invoice textboxes 1 and 2 with the remaining left blank.
Msgboxes were added along the way for error checking. I used the "Like" function to differentiate the top textboxes with the invoice textboxes to differentiate the input, as seen here:
For Each Ctr In Me.Controls
If TypeName(Ctr) = "TextBox" And Ctr.Name Like "Inv#*" Then
This worked fine. But the area of particular concern was in this section of code:
If Ctr.value <> "" Then
MsgBox ("Found a value!" & vbNewLine & Ctr.value)
If Application.WorksheetFunction.CountIf(.Worksheets("SOA").Range("A:A"), Ctr.value) Then
V = Application.WorksheetFunction.Match(Ctr.value, .Worksheets("SOA").Range("A:A"), 0)
If .Worksheets("SOA").Range(V, 7).value = "Unpaid" Then
.Worksheets("SOA").Range(V, 7).value = "Paid"
The Application.worksheetfunction.match is virtually unable to match any variable (e.g. Y = Ctr.value) with an error 1004 but works when I change Ctr.value to 1, like this:
V = Application.WorksheetFunction.Match(1, .Worksheets("SOA").Range("A:A"), 0)
I am new to userforms so I don't quite get some of its limitations. Any suggestions would be most welcome! I just learnt VBA coding about a week ago so I'm sure that I've got a long way to go. Here is the full code:
Private Sub OkButton_Click()
Dim SOA As ListObject
Dim Ctr As Control
Dim pPage As msforms.Page
Dim credit As ListRow
Dim V As Variant
With ThisWorkbook
Set SOA = .Worksheets("SOA").ListObjects(1) 'table name
Set credit = SOA.ListRows.Add(1) 'the new row, always add to the top
credit.Range(1, 2).value = Format(Now(), "mm/dd") 'Date
credit.Range(1, 3).value = ClientTextBox.value 'Client name
credit.Range(1, 6).value = DebitTextBox.value 'Credit Amt
For Each Ctr In Me.Controls
If TypeName(Ctr) = "TextBox" And Ctr.Name Like "Inv#*" Then
MsgBox (Ctr.Name)
If Ctr.value <> "" Then
MsgBox ("Found a value!" & vbNewLine & Ctr.value)
If Application.WorksheetFunction.CountIf(.Worksheets("SOA").Range("A:A"), Ctr.value) Then
V = Application.WorksheetFunction.Match(Ctr.value, .Worksheets("SOA").Range("A:A"), 0)
If .Worksheets("SOA").Range(V, 7).value = "Unpaid" Then
.Worksheets("SOA").Range(V, 7).value = "Paid"
Else: MsgBox ("Invoice #" & Ctr.value & " has already been paid!")
End If
Else
MsgBox ("Didn't find the number")
End If
End If
End If
Next
End With
Unload Me
End Sub
Your Ctr.Value is a String value. E.g. "1".
The Application.WorksheetFunction.CountIf(.Worksheets("SOA").Range("A:A"), Ctr.value) will count even if the values in the Range are numbers. This is because the second parameter of CountIf is expected as a String since it could also be ">1" or "<1" or "<>1".
But Application.WorksheetFunction.Match(Ctr.value, .Worksheets("SOA").Range("A:A"), 0) will not match if the Ctr.Value is "1" but the values in the range are numbers.
So if the values in the range are numbers, you must convert Ctr.Value to a number value before using in Match.
Example:
Application.WorksheetFunction.Match(CLng(Ctr.value), .Worksheets("SOA").Range("A:A"), 0)