PDA

View Full Version : Solved: Finding Information in one spreadsheet to populate another spreadsheet



dlssargent
06-25-2008, 08:56 AM
I want to create a macro or Vb script that will access a predetermined file, called “ALL PRICES” file, that is in a predetermined location.


After accessing the file, I want to know the last updated price of all materials that I have in another file, called “Designated Prices”. An Indicator, such as an “X, Y, USE, or etc” and Material # are the unique identifiers for “ALL PRICES”. A use indicator will tell the vb script/macro whether to use that price for a certain material.



If there is no data in “ALL PRICES” for a certain material then “Designated Prices” will not record anything for that material. If the material is in “ALL PRICES” and “Designated Prices”, “Designated Prices” should be populated with the price for the material. I want to bring back Date, Material, Name, Supplier, Delv price per MT from the spreadsheet.


Could I look for the indicator in the rows, if a row does not have the indicator delete it? Could I make an instance of “ALL PRICES” while I was programming it so not to affect it when deleting the rows as I suggested an keep the memory low in excel?

Edit Oorang: Making the entire text BOLD AND RED will not affect the speed of response ;)

Edit Lucas: Obnoxious formatting removed.

Edit Oorang: :rofl: That particular obnoxious formatting was actually mine. Sorry :)

Oorang
06-25-2008, 09:58 AM
Hi DLS,

Welcome to the board! :)

I think you have described your proposed program very well, as you are new I though I'd give you a few tips to elicit a speedier response.
Please post one a workbook with two worksheets. One the worksheet you are attempting to import data in to and the other the one that you are trying to import date from (put them both in one workbook for now. Also please include some sample data in both sheets so anyone who assists you can test their code more easily before posting it. Finally, post what code you do have (if any) so no one is recreating the wheel:)

lucas
06-25-2008, 10:03 AM
You are asking for a major project here. Do you expect that someone will magically provide this program for you? You should start it and provide sample workbooks and let us help you with it one step at a time. if you wish to pay for this completed project you can select "Consulting" from the link at the top of the page that says "Site Links".

For instance, which file in your lineup is the example you have posted. Will it be the one that is closed and data retrieved from?

Oorang
06-25-2008, 12:50 PM
Lucas is right in that you will should expect it to take some time to get all the pieces you need. But you have to start somewhere, so don't be afraid to ask basic questions (or many questions). All we ask is that you your best first to do it for yourself (so you learn) and when you hit a wall, post up your question on how to overcome the obstacle (so you won't get frustrated). As long as you aren't expecting someone else to do the work for you end to end, I doubt anyone will complain no matter how much help you ask for. That is why we are here :)

dlssargent
09-03-2008, 11:01 PM
Private Sub Get_Material_Num()
Application.ScreenUpdating = False
Dim tosheet As Worksheet
Dim XferMatNum As Long
Dim XferMatUpdated As String
Dim StoreRowNum As Double
Dim LenofUpdateCell As Integer


Dim wksSheet As Worksheet
Set wksSheet = ThisWorkbook.Worksheets("Feedstock Input")

'' Contract Prices File read
Dim rowCount As Integer

rowCount = IIf(IsEmpty(wksSheet.Range("A65536")), wksSheet.Range("A65536").End(xlUp).Row, 65536)

'First I have to iterate through the feedstock input sheet to get the material number
'How to check to see if the whole column is empty
For rwnumber = 12 To rowCount
If IsEmpty(wksSheet.Cells(rwnumber, 3).Value) = False Then
XferMatNum = Trim(wksSheet.Cells(rwnumber, 3).Value)
StoreRowNum = Trim(rwnumber)
If Get_Feedstock_Prices(XferMatNum, StoreRowNum) = "Yes" Then
XferMatUpdated = "Yes " & Now() '' if it was found
wksSheet.Cells(rwnumber, 5).Value = XferMatUpdated
' Go take XferMatnum into find function in other sheet
'''Leave information in the sheet as it is if it not found and got to the else statment
'If Variable is found in the other sheet then
Else
XferMatUpdated = wksSheet.Cells(rwnumber, 5).Value
LenofUpdateCell = Len(XferMatUpdated)
' XferMatUpdated = Right(XferMatUpdated, LenofUpdateCell - 3)
XferMatUpdated = "Not Updated"
' XferMatUpdated = "No, not updated. Last Updated, " & XferMatUpdated
wksSheet.Cells(rwnumber, 5).Value = XferMatUpdated

End If
End If
Next rwnumber

Set wksSheet = Nothing
End Sub
Private Function Get_Feedstock_Prices(XferMatNum, StoreRowNum) As String

Application.ScreenUpdating = False
'The workbook we are getting the information from
Dim fromBook As Workbook
Dim wksSheetFindMaterialinSheet As Worksheet

'The string we are finding in the workbook
Dim GetXferMatNum As String
GetXferMatNum = XferMatNum

'The row from which the material num is coming from
Dim GetStoreRowNum As Double
GetStoreRowNum = StoreRowNum
' THis Sheet in the excel file
Dim tosheet As Worksheet
Set tosheet = ThisWorkbook.Worksheets("Feedstock Input")
Dim SheetRange As String
SheetRange = "B2:B65536"

ContractPricesFile = "C:\Documents and Settings\dsargent2\Desktop\darron excel\ContractedPrices.xls"

Set fromBook = Workbooks.Open(ContractPricesFile, False, True)
fromBook.IsAddin = False ' Lie to excel and make it think the workbook is an addin. Will hide workbook.

Set wksSheetFindMaterialinSheet = fromBook.Worksheets(1)

Dim rowcountfrom As Integer
Dim FindMat As Range
Dim FoundMat As String
Dim UpdateColumn As Integer
Dim UpdateColumnEntry As String
Dim ReturnString As String


Application.ScreenUpdating = False

' ' Contract Prices File read
Dim rowCount As Integer
Dim Lastrow As Integer

rowcountfrom = IIf(IsEmpty(wksSheetFindMaterialinSheet.Range("A65536")), wksSheetFindMaterialinSheet.Range("A65536").End(xlUp).Row, 65536)

' 1. Find the variable, then look for an X or x in the 3rd column

' 2. Iterate through column C to find if the value = X and if so, copy RangeSpec
' of data to ActiveSheet

' 3. I need to make this code check to see if the name for the row marked with X already exist
' in the sheet, can i check if feedstock is in there and verify if the other entries are the same as what
' is already in there -->toSheet.Range("A12:A" & rowCount).Delete
'For rwNumber = 1 To rngTMP

'Set the range in which we want to search in
ReturnString = "No"
With wksSheetFindMaterialinSheet.Range(SheetRange)
'Search for the first occurrence of the item
Set FindMat = .Find(GetXferMatNum, , , LookAt:=xlWhole)
'If a match is found then
If Not FindMat Is Nothing Then
'Store the address of the cell where the first match is found in a variable
FoundMat = FindMat.Address
Do
UpdateColumn = 3
UpdateColumnEntry = wksSheetFindMaterialinSheet.Cells(FindMat.Row, UpdateColumn).Value
If UpdateColumnEntry = "X" Then
'Need to paste info into the other sheet
'in the same row as the material was found
CopyPasteFrom_OnlyOneCell tosheet, wksSheetFindMaterialinSheet, "D", "D", "A", FindMat.Row, GetStoreRowNum 'row starts at 12
CopyPasteFrom_OnlyOneCell tosheet, wksSheetFindMaterialinSheet, "E", "E", "D", FindMat.Row, GetStoreRowNum
CopyPasteFrom_OnlyOneCell tosheet, wksSheetFindMaterialinSheet, "A", "A", "F", FindMat.Row, GetStoreRowNum
CopyPasteFrom_OnlyOneCell tosheet, wksSheetFindMaterialinSheet, "K", "K", "G", FindMat.Row, GetStoreRowNum
ReturnString = "Yes"
ElseIf UpdateColumnEntry = "x" Then
'Need to paste info into the other sheet
'in the same row as the material was found
CopyPasteFrom_OnlyOneCell tosheet, wksSheetFindMaterialinSheet, "D", "D", "A", FindMat.Row, GetStoreRowNum 'row starts at 12
CopyPasteFrom_OnlyOneCell tosheet, wksSheetFindMaterialinSheet, "E", "E", "D", FindMat.Row, GetStoreRowNum
CopyPasteFrom_OnlyOneCell tosheet, wksSheetFindMaterialinSheet, "A", "A", "F", FindMat.Row, GetStoreRowNum
CopyPasteFrom_OnlyOneCell tosheet, wksSheetFindMaterialinSheet, "K", "K", "G", FindMat.Row, GetStoreRowNum
ReturnString = "Yes"
End If
'Search for the next cell with a matching value
Set FindMat = .FindNext(FindMat) 'getting an error
'Search for all the other occurrences of the item i.e.
'Loop as long matches are found, and the address of the cell where a match is found,
'is different from the address of the cell where the first match is found (FindAddress)
Loop While Not FindMat Is Nothing And FindMat.Address <> FoundMat And ReturnString = "No"
End If
End With


'Clear memory
Set FindMat = Nothing
Set wksSheetFindMaterialinSheet = Nothing
fromBook.IsAddin = False
fromBook.Close False
Set fromBook = Nothing
Get_Feedstock_Prices = ReturnString

End Function


Public Sub CopyPasteFrom_OnlyOneCell(tSheet, fSheet, cFrom, cTo, columnCopyTo, rNum, GetStoreRowNum)
Dim tosheet As Worksheet
Dim fromsheet As Worksheet
Dim rangeSpec As String

Set tosheet = tSheet
Set fromsheet = fSheet
If cFrom <> cTo Then
rangeSpec = cFrom & CStr(rNum) & ":" & cTo & CStr(rNum)
Else
rangeSpec = cFrom & CStr(rNum)
End If
fromsheet.Range(rangeSpec).Copy
tosheet.Range(columnCopyTo & CStr(GetStoreRowNum)).PasteSpecial xlPasteValuesAndNumberFormats

End Sub