I am a newbie at using Recordsets and need some assistance as to why the data is transposing from the Database to Excel. I believe its in the following code, but not sure.
For iRow = 0 To intNumReturned - 1
For iCol = 0 To intNumColumns - 1
Debug.Print rsRecords(iCol, iRow)
Next iCol
Next iRow
Result from SQL String, which is expected:
PROCESSOR | ACCOUNT NUMBER | LOAN AMOUNT | ORIGNATION DATE
ZJE xxxxxxx XXXXXX.XX 2018-01-01
ZJE xxxxxxx XXXXXX.XX 2018-02-06
How the data gets placed into the Excel Sheet:
PROCESSOR | ACCOUNT NUMBER | LOAN AMOUNT | ORIGNATION DATE
ZJE ZJE ZJE ZJE
acct no acct no acct no acct no
loan amt loan amt loan amt loan amt
Org Date Org Date Org Date org date
Below is the code i am currently using minus the Connection and SQL Strings:
Sub RunSearch()
Dim conn As New ADODB.Connection
Dim rs As New ADODB.Recordset
Dim connStr As String, strSQL As String
Dim begQ1 As String, endQ1 As String, begQ2 As String, endQ2 As String, begQ3 As String, endQ3 As String, begQ4 As String, endQ4 As String
Dim ctrl As Control
Dim rsRecords As Variant
Dim intNumReturned As Long, intNumColumns As Long, iCol As Long, iRow As Long, fldCount As Long, i As Long, rsCount As Long
Set wb = ThisWorkbook
Set wsVol = wb.Sheets("Volume By Processor")
Set wsDE = wb.Sheets("DE")
Set quarterYear = wsDE.Range("Quarter_Year")
Set Q = wsDE.Range("Quarter")
Set fDate = wsDE.Range("From_Date")
Set tDate = wsDE.Range("To_Date")
Do While Not rs.EOF
rs.MoveNext
rsRecords = rs.GetRows
intNumReturned = UBound(rsRecords, 2) + 1
intNumColumns = UBound(rsRecords, 1) + 1
Loop
For iRow = 0 To intNumReturned - 1
For iCol = 0 To intNumColumns - 1
Debug.Print rsRecords(iCol, iRow)
Next iCol
Next iRow
'\\\NEED TO FIGURE OUT NUMBER OF RECORDS TO
'\\\DEFINE LAST ROW/COLUMN OF RANGE???? PROBABLY A
'\\\SEPARATE QUESTION ON SO
wsVol.Range("B3:E1800") = rsRecords
rs.Close
Set rs = Nothing
conn.Close
Set conn = Nothing
I am expecting the result in the Excel sheet to match the the output from the SQL String any assistance is greatly appreciated.
If you want go to another "entry" of the recordset you can use ".MoveNext" method.
It will be something like this:
rsRecords.MoveFirst 'In this line you will back for the first entry
For iRow = 0 To intNumReturned - 1
For iCol = 0 To intNumColumns - 1
Debug.Print rsRecords(iCol)
Next iCol
rsRecords.MoveNext 'In this line you move to the next "row" as you want
Next iRow
Related
I am trying to sort through a couple hundred rows in a workbook to pull information based on progressive keys. First, create a list of all unique names, then for each unique name find all associated product codes, and finally create a list of each quantity of product. What it should look like:
'Name1
'-----product1
'-------------quantity1
'-------------quantity2
'-----product2
'-------------quantity1
'-------------quantity2
'name2
'-----product1
'-------------quantity1
'-------------quantity2
'-----product2
'-------------quantity1
'-------------quantity2
I tried using a dictionary but can't figure out how to get it to return more than the first entry per unique name. This is the code I have so far:
Sub CreateNameList2()
Application.ScreenUpdating = False
Dim wb As Workbook: Set wb = ThisWorkbook
Dim sws As Worksheet: Set sws = wb.Worksheets("Label-Mod Data")
Dim dict As Object: Set dict = CreateObject("Scripting.Dictionary")
dict.CompareMode = vbTextCompare
Dim AssociateName As String
Dim ColAssociateNames As Integer
Dim ColCurrentLabels As Integer
Dim ColPTSCodes As Integer
Dim ColRegionCodes As Integer
Dim nbRows As Long
Dim iRow As Integer
Dim i As Integer
Dim k As Variant
ColAssociateNames = 8
ColCurrentLabels = 9
ColPTSCodes = 14
ColRegionCodes = 15
nbRows = 155
i = 2
For iRow = 2 To nbRows
AssociateName = sws.Cells(iRow, ColAssociateNames).Value2
If Not dict.Exists(AssociateName) Then
dict.Add Key:=AssociateName, Item:=Array(sws.Cells(i, ColPTSCodes).Value2, sws.Cells(i, ColCurrentLabels).Value2, sws.Cells(i, ColRegionCodes).Value2)
i = i + 1
End If
Next iRow
iRow = 2
For Each k In dict.Keys
With sws
.Cells(iRow, 18).Value2 = k
.Cells(iRow, 19).Value2 = dict.Item(k)(0)
.Cells(iRow, 20).Value2 = dict.Item(k)(1)
.Cells(iRow, 21).Value2 = dict.Item(k)(2)
End With
iRow = iRow + 1
Next k
Set dict = Nothing
Debug.Print
Application.ScreenUpdating = True
End Sub
Can this be done with a dictionary?
For privacy reasons I can't show the data but I will try to explain it.
My raw data comes in 3 columns and varies in number of rows, todays is 155. Column 1 has a name, column 2 has a product ID and column 3 has a quantity. There are currently 48 possible names, 12 possible product ID's and undetermined quantity amounts. Looks Like this:
Name1 | product 3 | 25
Name1 | product 1 | 12
Name5 | product 9 | 171
Name4 | product 3 | 48
Name1 | product 7 | 23
Name42 | product 9 | 9
Name5 | product 1 | 22
Name4 | product 3 | 42
What I need to do is change it to:
Name1 | product 1 | 12
| product 3 | 25
| product 7 | 23
Name4 | product 3 | 90
(combine above quantity with matching name and product)
Name5 | product 1 | 22
| product 9 | 171
Name42 | product 9 | 9
Like this would work:
Sub Tester()
Dim dict As Object, rw As Range, Q, kN, kP
Set dict = CreateObject("scripting.dictionary")
Set rw = Range("A1:C1") 'first row of data
Do While Application.CountA(rw) = 3 'while row data is complete
kN = rw.Cells(1).Value 'name key
kP = rw.Cells(2).Value 'product key
Q = rw.Cells(3).Value 'quantity
'add keys if missing...
If Not dict.exists(kN) Then dict.Add kN, CreateObject("scripting.dictionary")
If Not dict(kN).exists(kP) Then dict(kN).Add kP, 0
dict(kN)(kP) = dict(kN)(kP) + Q 'sum quantity for this key combination
Set rw = rw.Offset(1) 'next row
Loop
'output to Immediate pane
For Each kN In dict
Debug.Print "---" & kN & "---"
For Each kP In dict(kN)
Debug.Print " " & kP & " = " & dict(kN)(kP)
Next
Next kN
End Sub
Based on the additional information provided, it looks like you can make use of a composite key comprised of the Name and Product identifiers. Doing so can support a solution that uses an AssociateName-to-nameProductQuantityMap Dictionary where nameProductQuantityMap is also a Dictionary that associates Quantity totals to each Name + Product composite key.
Option Explicit
'May need a more elaborate delimiter if "." used in the Names or Products
Const compositeKeyDelimiter As String = "."
Private Type TColumns
Associate As Long
Name As Long
Product As Long
Quantity As Long
End Type
Sub CreateNameList2Answer()
Application.ScreenUpdating = False
Dim wb As Workbook: Set wb = ThisWorkbook
Dim sws As Worksheet: Set sws = wb.Worksheets("Label-Mod Data")
Dim dict As Object: Set dict = CreateObject("Scripting.Dictionary")
dict.CompareMode = vbTextCompare
Dim AssociateName As String
Dim ColAssociateNames As Integer
Dim ColCurrentLabels As Integer
Dim ColPTSCodes As Integer
Dim ColRegionCodes As Integer
Dim nbRows As Long
Dim iRow As Integer
Dim i As Integer
ColAssociateNames = 8
ColCurrentLabels = 9
ColPTSCodes = 14
ColRegionCodes = 15
nbRows = 155
i = 2
'Modify if these are not mapped to the correct column names
Dim xColumns As TColumns
xColumns.Associate = ColAssociateNames
xColumns.Name = ColCurrentLabels
xColumns.Product = ColPTSCodes
xColumns.Quantity = ColRegionCodes
Dim xAssociateName As Variant
Dim xName As String
Dim xProduct As String
Dim xQuantity As Long
Dim xCompositeKey As String
Dim nameProductQuantityMap As Object
For iRow = 2 To nbRows
AssociateName = sws.Cells(iRow, xColumns.Associate).Value2
xName = sws.Cells(i, xColumns.Name).Value2
xProduct = sws.Cells(i, xColumns.Product).Value2
xQuantity = CLng(sws.Cells(i, xColumns.Quantity).Value2)
xCompositeKey = CreateCompositeKey(xName, xProduct)
If Not dict.Exists(AssociateName) Then
dict.Add Key:=AssociateName, Item:=CreateObject("Scripting.Dictionary")
End If
Set nameProductQuantityMap = dict.Item(AssociateName)
If Not nameProductQuantityMap.Exists(xCompositeKey) Then
nameProductQuantityMap.Add xCompositeKey, 0
End If
nameProductQuantityMap.Item(xCompositeKey) _
= nameProductQuantityMap.Item(xCompositeKey) + xQuantity
i = i + 1
Next iRow
iRow = 2
Dim xKey As Variant
For Each xAssociateName In dict.Keys
Set nameProductQuantityMap = dict.Item(xAssociateName)
For Each xKey In nameProductQuantityMap
LoadContent sws, iRow, CStr(xAssociateName), _
CStr(xKey), _
nameProductQuantityMap.Item(xKey)
iRow = iRow + 1
Next
Next xAssociateName
Set dict = Nothing
Set nameProductQuantityMap = Nothing
Debug.Print
Application.ScreenUpdating = True
End Sub
Private Sub LoadContent(ByVal pWksht As Worksheet, ByVal pRow As Long, _
ByVal pAssociate As String, _
ByVal pCompositeKey As String, _
ByVal pQuantity As Long)
Dim xName As String
Dim xProduct As String
ExtractNameAndProductFromKey pCompositeKey, xName, xProduct
With pWksht
.Cells(pRow, 18).Value2 = pAssociate
.Cells(pRow, 19).Value2 = xName
.Cells(pRow, 20).Value2 = xProduct
.Cells(pRow, 21).Value2 = pQuantity
End With
End Sub
Private Function CreateCompositeKey(ByVal pName As String, ByVal pProduct As String) As String
CreateCompositeKey = pName & compositeKeyDelimiter & pProduct
End Function
Private Sub ExtractNameAndProductFromKey(ByVal pCompositeKey As String, ByRef pOutName As String, ByRef pOutProduct As String)
Dim xKeyParts As Variant
xKeyParts = Split(pCompositeKey, compositeKeyDelimiter)
pOutName = xKeyParts(0)
pOutProduct = xKeyParts(1)
End Sub
I have a bunch of word documents that each contain a single table, some of which hold an exorbitant amount of data (20,000+ rows perhaps) and hence can stretch over hundreds of pages long.
With that being said, I found a VBA word macro that can display all row indices that start every page. For example, the macro will display 100 integers for a table that stretches for 100 pages. This is exactly what I need but for various reasons, the macro runs very slow. Furthermore, it runs even slower when I adapted the code and embedded it into an excel macro (to use on a word object).
So my question is - can this macro be somehow optimized? I suppose the looping is causing the problem. Many thanks for your input!
Sub TableRowData()
'define meaningful names to use for array's first dimension
Const pgnum = 1
Const startrow = 2
Const endrow = 3
Dim data() As Long ' array to hold data
Dim rw As Row ' current row of table
Dim rownum As Long ' the index of rw in table's rows
Dim datarow As Long ' current value of array's second dimension
Dim rg As Range ' a range object for finding the page where rw starts
'initialization
ReDim data(3, 1)
Set rw = ActiveDocument.Tables(1).Rows(1)
rownum = 1
datarow = 1
'store the page number and row number for the first row of the table
Set rg = rw.Range
rg.Collapse wdCollapseStart
data(pgnum, datarow) = rg.Information(wdActiveEndAdjustedPageNumber)
data(startrow, datarow) = rownum
'Step through the remaining rows of the table.
'Each time the page number changes, store the preceding row as the
'last row on the previous page; then expand the array and store the
'page number and row number for the new row.
While rownum < ActiveDocument.Tables(1).Rows.Count
Set rw = rw.Next
rownum = rownum + 1
Set rg = rw.Range
rg.Collapse wdCollapseStart
If rg.Information(wdActiveEndAdjustedPageNumber) > data(pgnum, datarow) Then
data(endrow, datarow) = rownum - 1
ReDim Preserve data(3, datarow + 1)
datarow = datarow + 1
data(pgnum, datarow) = rg.Information(wdActiveEndAdjustedPageNumber)
data(startrow, datarow) = rownum
End If
Wend
'finish up with the last row of the table
data(endrow, datarow) = rownum
Dim msg As String
Dim i As Long
For i = 1 To UBound(data, 2)
msg = msg & data(startrow, i) & vbCr
Next i
MsgBox msg
End Sub
Try something based on:
Sub TableRowData()
Dim Doc As Document, Rng As Range, Data() As Long, i As Long, j As Long, p As Long, r As Long, x As Long
Set Doc = ActiveDocument
With Doc
With .Tables(1).Range
i = .Cells(1).Range.Characters.First.Information(wdActiveEndAdjustedPageNumber)
j = .Cells(.Cells.Count).Range.Characters.Last.Information(wdActiveEndAdjustedPageNumber)
ReDim Data(3, j - i)
For p = i To j
Set Rng = Doc.Range.GoTo(What:=wdGoToPage, Name:=p)
Set Rng = Rng.GoTo(What:=wdGoToBookmark, Name:="\page")
r = Rng.Cells(1).RowIndex
x = p - i: Data(1, x) = x: Data(2, x) = p: Data(3, x) = r
Next
End With
End With
End Sub
Processing tables row by row is notoriously slow and there is little you can do to speed things up.
One thing that will help is to turn off screen updating. At the start of your routine add Application.ScreenUpdating = False and at the end Application.ScreenUpdating = True.
The other thing you can experiment with is using a For Each loop. There is some disagreement as to whether or not this method is faster. Having a large table to process will give you a pretty good idea of which is the faster method, but don't expect miracles. Whichever method you adopt you are going to need patience.
Sub TableRowData()
Application.ScreenUpdating = False
'define meaningful names to use for array's first dimension
Const pgnum = 1
Const startrow = 2
Const endrow = 3
Dim data() As Long ' array to hold data
Dim rw As Row ' current row of table
Dim rownum As Long ' the index of rw in table's rows
Dim datarow As Long ' current value of array's second dimension
'Dim rg As Range ' a range object for finding the page where rw starts
'initialization
ReDim data(3, 1)
Set rw = ActiveDocument.Tables(1).Rows(1)
rownum = 1
datarow = 1
'store the page number and row number for the first row of the table
Set rg = rw.Range
rg.Collapse wdCollapseStart
data(pgnum, datarow) = rg.Information(wdActiveEndAdjustedPageNumber)
data(startrow, datarow) = rownum
'Step through the remaining rows of the table.
'Each time the page number changes, store the preceding row as the
'last row on the previous page; then expand the array and store the
'page number and row number for the new row.
'While rownum < ActiveDocument.Tables(1).Rows.Count
For Each rw In ActiveDocument.Tables(1).Rows
'Set rw = rw.Next
rownum = rownum + 1
'Set rg = rw.Range
'rg.Collapse wdCollapseStart
If rw.Range.Information(wdActiveEndAdjustedPageNumber) > data(pgnum, datarow) Then
data(endrow, datarow) = rownum - 1
ReDim Preserve data(3, datarow + 1)
datarow = datarow + 1
data(pgnum, datarow) = rw.Range.Information(wdActiveEndAdjustedPageNumber)
data(startrow, datarow) = rownum
End If
Next rw
'Wend
'finish up with the last row of the table
data(endrow, datarow) = rownum
Dim msg As String
Dim i As Long
For i = 1 To UBound(data, 2)
msg = msg & data(startrow, i) & vbCr
Next i
MsgBox msg
Application.ScreenUpdating = True
End Sub
How about looping through the pages and getting the row number?
Would that work?
Dim doc As Document
Dim rng As Range
Dim pg As Long
Application.ScreenUpdating = False
Set doc = ThisDocument
For pg = 1 To doc.Range.Information(wdNumberOfPagesInDocument)
Set rng = doc.GoTo(wdGoToPage, wdGoToAbsolute, pg)
Debug.Print rng.Information(wdEndOfRangeRowNumber)
Next pg
I'm running into a "run time error 1004". I suspect this has something to do with how much data I want my code to process. Currently I am running a 246 column by 30,000 row. What I'm trying to achieve is to consolidate my data into one row item because the current system export the data into individual row as a duplicate for certain data columns. As a result, the data has a ladder/stagger effect where there's duplicate row ID with blank cells in one and data below it.
Example:
Code:
Option Explicit
Sub consolidate()
Const SHEET_NAME = "Archer Search Report"
Const NO_OF_COLS = 101
Dim wb As Workbook, ws As Worksheet
Dim irow As Long, iLastRow As Long, c As Long, count As Long
Set wb = ThisWorkbook
Set ws = wb.Sheets(SHEET_NAME)
iLastRow = ws.Range("A" & Rows.count).End(xlUp).Row
' scan up sheet
For irow = iLastRow - 1 To 2 Step -1
' if same id below
If ws.Cells(irow + 1, 1) = ws.Cells(irow, 1) Then
' scan across
For c = 1 To NO_OF_COLS
' if blank copy from below
If Len(ws.Cells(irow, c)) = 0 Then
ws.Cells(irow, c) = ws.Cells(irow + 1, c)
End If
Next
ws.Rows(irow + 1).Delete
count = count + 1
End If
Next
MsgBox iLastRow - 1 & " rows scanned" & vbCr & _
count & " rows deleted from " & ws.Name, vbInformation
End Sub
I suspect it has to do with the massive amount of data it's running and wanted to see if that is the case. If so, is there an alternative approach? Appreciate the assistance.
Note: I got this awesome code from someone(CDP1802)here and have been using it for years with smaller data set.
Here's a slightly different approach which does not require sorting by id, includes some checking for error values, and does not overwrite any data in the output.
Sub consolidate()
Const SHEET_NAME = "Archer Search Report"
Const NO_OF_COLS = 10 'for example
Dim wb As Workbook, ws As Worksheet, dataIn, dataOut
Dim i As Long, c As Long
Dim dict As Object, id, rwOut As Long, idRow As Long, vIn, vOut, rngData As Range
Set wb = ThisWorkbook
Set ws = wb.Sheets(SHEET_NAME)
Set dict = CreateObject("scripting.dictionary")
Set rngData = ws.Range("A2:A" & ws.Cells(ws.Rows.count, 1).End(xlUp).Row).Resize(, NO_OF_COLS)
dataIn = rngData.Value 'input data as 2D array
ReDim dataOut(1 To UBound(dataIn, 1), 1 To NO_OF_COLS) 'resize "out" to match "in" array size
rwOut = 0 'row counter for "out" array
For i = 1 To UBound(dataIn, 1)
id = dataIn(i, 1) 'id for this "row"
If Not dict.exists(id) Then
'not seen this id before
rwOut = rwOut + 1
dict(id) = rwOut 'add id and row to dictionary
dataOut(rwOut, 1) = id 'add id to "out" array
End If
idRow = dict(id) 'row locator in the "out" array
For c = 2 To NO_OF_COLS
vIn = dataIn(i, c) 'incoming value
vOut = dataOut(idRow, c) 'existing value
'ignore error values, and don't overwrite any existing value in the "out" array
If Not IsError(vIn) Then
If Len(vIn) > 0 And Len(vOut) = 0 Then dataOut(idRow, c) = vIn
End If
Next c
Next i
rngData.Value = dataOut 'replace input data with output array
MsgBox "Got " & rwOut & " unique rows from " & UBound(dataIn, 1)
End Sub
As you can see that the value in column Amount in the first image is manually put into it. I would like to use VBA to do it automatically.
Table B546789 is one of the worker:
PriceList shown the amount of each code item:
Code:
Sub FINDSAL()
Dim E_name() As String
Dim Sal As String
Dim sheet As Worksheet
Set sheet = ActiveWorkbook.Sheets("PriceList")
SourceString = Worksheets("B546789").Range("B2").Value
E_name() = Split(SourceString, ",")
Sal = Application.WorksheetFunction.VLookup(E_name, Worksheets("PriceList").Range("A2:B7"), 2, False)
End Sub
A simple SUMPRODUCT should do this.
=SUMPRODUCT(--ISNUMBER(FIND(F$2:F$8, B2)), G$2:G$8)
VBA code:
Dim a As Long, b As Long, ttl As Double
Dim vals As Variant, pc As Variant
Dim sh As Worksheet
Set sh = ActiveWorkbook.Sheets("PriceList")
With Worksheets("B546789")
For b = 2 To .Cells(.Rows.Count, "B").End(xlUp).Row
ttl = 0
vals = Split(.Cells(b, "B").Value2, Chr(44))
For a = LBound(vals) To UBound(vals)
pc = Application.Match(vals(a), sh.Columns(1), 0)
If Not IsError(pc) Then
ttl = ttl + sh.Cells(pc, "B").Value2
End If
Next a
.Cells(b, "C") = ttl
Next b
End With
Any hints that when i put below code to VBA ThisWorkbook, work fine. But assign this Marco to a button, it will crash when i run. do you know why?
Sub test()
Dim a As Long, b As Long, ttl As Double, ttlerror As String
Dim vals As Variant, pc As Variant
Dim sh As Worksheet
Dim WshtNames As Variant
Dim WshtNameCrnt As Variant
Set sh = ActiveWorkbook.Sheets("PriceList")
WshtNames = Array("B54546", "B87987")
For Each WshtNameCrnt In WshtNames
With Worksheets(WshtNameCrnt)
For b = 8 To [D8].End(xlDown).Row
ttl = 0
ttlerror = ""
vals = Split(.Cells(b, "D").Value2, Chr(44))
For a = LBound(vals) To UBound(vals)
pc = Application.Match(vals(a), sh.Columns(1), 0)
If Not IsError(pc) Then
ttl = ttl + sh.Cells(pc, "B").Value2
End If
Next a
.Cells(b, "E") = ttl
.Cells(b, "F") = ttlerror
Next b
End With
Next WshtNameCrnt
End Sub
the issue maybe related to this "For b = 8 To [D8].End(xlDown).Row", it only happen when i use the button feature.
Image here
I'm trying to search Rows in an Excel-File in which three criteria are met. They are in Columns K, L and AJ. If those Kriterias are met I want to look at the Price (Column AM). If there are multiple Rows who meet the criteria, I find an average price and You can see it in the output cell.
I dont know what I am doing wrong. I always get the MsgBox from the last if loop.
Any help would be greatly appreciated
Thanks a lot!
Option Explicit
Sub FindAndAverage()
Dim findenPN As String
Dim findenVend As String
Dim findenWS As String
Dim Preis As Double
Dim Added As Double
Dim Anzahl As Long
Dim iRow As Long
Dim RowMax As Long
Dim Avrg As Double
'fill Variables
findenPN = Worksheets("Sheet2").Range("C3").Value
findenPN = Worksheets("Sheet2").Range("C4").Value
findenPN = Worksheets("Sheet2").Range("C5").Value
Preis = 0
Added = 0
Anzahl = 0
iRow = 2
Avrg = 0
With ThisWorkbook.Worksheets("Sheet1").Activate
RowMax = ActiveSheet.UsedRange.Rows.Count
For iRow = 2 To RowMax
If Cells(iRow, 12).Value = findenPN And Cells(iRow, 11).Value = findenVend And Cells(iRow, 36).Value = findenWS Then
'Look fpor price in column AM
Preis = Cells(iRow, 39).Value
'Add price to other results
Added = Added + Preis
'go to next row
iRow = iRow + 1
'Add one for Average
Anzahl = Anzahl + 1
Else
iRow = iRow + 1
End If
Next iRow
End With
If Anzahl > 0 Then
'Output in Sheet2
With ThisWorkbook.Worksheets("Sheet2").Activate
Avrg = Added / Anzahl
Range("C9").Value = Avrg
End With
Else
MsgBox ("Kein Ergebniss!")
End If
End Sub
You don't really need VBA for that. Worksheet formula would be enough:
=AVERAGEIFS(Sheet1!M:M,Sheet1!K:K,Sheet1!C3,Sheet1!L:L,Sheet1!C4,Sheet1!AJ:AJ,Sheet1!C5)
You are declaring 3 variables but you are leaving 2 empty for the rest of the code, validation will never meet this way.
Dim findenPN As String
Dim findenVend As String
Dim findenWS As String
'fill Variables
findenPN = Worksheets("Sheet2").Range("C3").Value
findenPN = Worksheets("Sheet2").Range("C4").Value
findenPN = Worksheets("Sheet2").Range("C5").Value
You are missing to declare findenVend and findenWS Values.