What kind of "problem in the code" are we supposed to look for?at initial
glance, all of the spacing is wrong, all of the syntax is wrong.But that is
because sending this embedded in the email as you have has messed up all of the
spacing and indentation (if there is any)
Next, without having a copy of the data (file1 and file2)I cannot BEGIN to know
if the issue is with the code not recognizing the data, or??
Is it possible to get samples of the three files and this macro in a module of
excel?
Otherwise, I could spend hours simply cleaning up this format and GUESSING at
what file1 and file2 look like.Only to guess wrong and never come close to the
issue you're trying to solve. Paul-----------------------------------------
“Do all the good you can,
By all the means you can,
In all the ways you can,
In all the places you can,
At all the times you can,
To all the people you can,
As long as ever you can.” - John Wesley
-----------------------------------------
On Thursday, February 4, 2016 5:57 AM, Saurabh Karangutkar
<saurabh12...@gmail.com> wrote:
- Here is the problem
Sheet 1 - file 1 is base datafile thats maps our master product file with
master product file received from our suppliers / merchants listing supplier
product code to our product code, and supplier name to our name. This is
prepared basis a one time exercise.
- Sheet 1 - file 2 is daily price list that we receive from the supplier in
that format - it lists down supplier product code, supplier product name, MRP
i.e. list price, selling price - at times this is at a discount to list price,
and quantity available for sale.
- Sheet 1 - file 3 is the format in which we need output basis mapping of
sheet 1 with sheet 2. Instructions are given against each field. We use file 3
to upload the file in our system that calculates final selling price to retail
consumers. Our agents often refer this final file while discussing sales with
potential customers.
Here is the code . Please let me know what is the problem in the code . Not
able to get it .
-
Public FPMfolder AsString'* the foldername
Public FinalPM AsString'* the filename
'* value below will hold the values based upon the value in B4
Public DPMfolder AsString'* the foldername
Public DailyPM AsString'* the filename
Public OFolder AsString'* this will hold the foldername based upon the value in
B5
Public FinalOutput AsString'* this will hold the actual outputfile name
Public wbTool As Workbook '* will be used to refer to the 'PriceMappingTool'
file
Public wsTool As Worksheet '* refer to sheet named 'Main'
Public wbFPM As Workbook '* this will refer to the actual file named in B3
Public wsFPM As Worksheet '* the sheet of the above file where the data is to
be found
Public wbDPM As Workbook '* this will refer to the actual file named in B4
Public wsDPM As Worksheet '* the sheet of the above file where the data is to
be found
Public wbFPO As Workbook '* this will be used to refer to the file named on
FinalOutput
Public wsFPO1 As Worksheet '* the sheet where the output data will be written
to Sheet(1)
Public wsFPO2 As Worksheet '* the sheet where the output data will be written
to Sheet(2)
Public wsFPO3 As Worksheet '* the sheet where the output data will be written
to Sheet(3)
Public Merchant AsString'* if and when used to store the value of the selected
Merchant's name
Public Acronym AsString'* if and when used to store the corresponding Acronym
of the selected Merchant
Public ProcOK AsBoolean
Public FSPLIT AsVariant'* used to extract filename and foldername from variable
Public PressedState AsBoolean'* to trap Esc or Cancel button pressed
PublicSub MapAndConsolidate()
ProcOK =False: PressedState =False
Set wbTool = Workbooks("PriceMappingTool.xlsm")
Set wsTool = wbTool.Sheets("Main")
wbTool.Activate
If Len(Trim(wsTool.Range("B2")))=0Or Len(Trim(wsTool.Range("B3")))=0Or
Len(Trim(wsTool.Range("B4")))=0OrLen(Trim(wsTool.Range("B5")))=0Then
MsgBox "Please verify THAT all the input values have been entered!",
vbCritical,"OPERATION ABORTED !!!"
ExitSub
EndIf
Application.ScreenUpdating =False
'* below sets all the variables based upon the input values
FSPLIT = Split(wsTool.Range("B3").Value, Application.PathSeparator)
FinalPM = FSPLIT(CInt(UBound(FSPLIT)))
FPMfolder = Replace(wsTool.Range("B3").Value, FinalPM,"")
If Right(FPMfolder,1)<> Application.PathSeparator Then FPMfolder = FPMfolder &
Application.PathSeparator
FSPLIT = Split(wsTool.Range("B4").Value, Application.PathSeparator)
DailyPM = FSPLIT(CInt(UBound(FSPLIT)))
DPMfolder = Replace(wsTool.Range("B4").Value, DailyPM,"")
If Right(DPMfolder,1)<> Application.PathSeparator Then DPMfolder = DPMfolder &
Application.PathSeparator
OFolder = wsTool.Range("B5").Value
If Right(OFolder,1)<> Application.PathSeparator Then OFolder = OFolder &
Application.PathSeparator
Merchant = wsTool.Range("B2").Value
Acronym = findAcronym(wsTool.Range("B2").Value)
If Len(Trim(Acronym))=0Then Acronym ="XXX"
OnErrorResumeNext
Set wbFPM = Workbooks(FinalPM)
If wbFPM IsNothingThenSet wbFPM = Workbooks.Open(Filename:=FPMfolder &
FinalPM,ReadOnly:=True)
If wbFPM IsNothingThenGoTo exitNoGo
Set wbDPM = Workbooks(DailyPM)
If wbDPM IsNothingThenSet wbDPM = Workbooks.Open(Filename:=DPMfolder &
DailyPM,ReadOnly:=True)
If wbDPM IsNothingThenGoTo exitNoGo
'Set wbFOP = Workbooks(FinalOutP)
'If wbFOP Is Nothing Then Set wbFOP = Workbooks.Open(Filename:=filePath &
Application.PathSeparator & FinalOutP)
'If wbFOP Is Nothing Then GoTo exitNoGo
FinalOutput ="Final_Output-"& Format(Now(),"dd-mm-yyyy-HHmm")&"_"&
Trim(Acronym)&".xlsx"
Err.Clear
OnErrorGoTo0
wbTool.Activate
Application.ScreenUpdating =True
If MsgBox("Base mapping file:"& vbCrLf & Chr(9)& wbFPM.Name & vbCrLf & _
"Daily Price Master file:"& vbCrLf & Chr(9)& wbDPM.Name & vbCrLf & _
"Output file:"& vbCrLf & Chr(9)& FinalOutput & vbCrLf & vbCrLf &"'OK' to
continue?"& vbCrLf & vbCrLf & Chr(9)& _
"press 'Ctlr + Break' to stop processing at any time", vbOKCancel,"Price
Mapping Tool"& Space(5)&"HC&TS, 2015")<> vbOKThenGoTo exitSub
With Application
.ScreenUpdating =False
.EnableEvents =False
.Calculation = xlCalculationManual
.EnableCancelKey = xlDisabled
EndWith
Set wbFPO = Workbooks.Add
wbFPO.SaveAs Filename:=OFolder & FinalOutput, FileFormat:=51
'* the thre following rows adds the column headers to the three worksheets
fillColumnHeaders ws:=Sheets(1)
If wbFPO.Worksheets.Count =1Then wbFPO.Worksheets.Add
fillColumnHeaders ws:=Sheets(2)
If wbFPO.Worksheets.Count =2Then wbFPO.Worksheets.Add
fillColumnHeaders ws:=Sheets(3)
Set wsFPO1 = wbFPO.Sheets(1)
wsFPO1.Name ="Price records found"
Set wsFPO2 = wbFPO.Sheets(2)
wsFPO2.Name ="no Price records found"
Set wsFPO3 = wbFPO.Sheets(3)
wsFPO3.Name ="multiple Price records found"
wbFPO.Save
wbDPM.Activate
Dim tStart AsDate'* start timer
Dim tStop AsDate'* stop timer
Dim tEnd AsDate'* estimated end time
Dim tmidnite AsDate'* extra timer value if the process is started before and
ends after midnight (next day)
tStart = Format(Now(),"hh:mm:ss")
tmidnite = Format(TimeValue("23:59:59"),"hh:mm:ss")
Dim FPMrng As Range '* range will refer to the data in the Final Product
Mapping file
Dim DPMrng As Range '* range will refer to the data in the Daily Price Master
file receiveed from Supplier
Dim lstFPMRow AsLong
Dim lstDPMRow AsLong
Dim FPMRow AsLong
Dim DPMRow AsLong
Dim FPO1Row AsLong
Dim FPO2Row AsLong
Dim FPO3Row AsLong
Set wsFPM = wbFPM.Sheets("Final Matched")
Set wsDPM = wbDPM.Sheets(1)
lstFPMRow = WorksheetFunction.Max(2, wbFPM.Sheets(1).Range("A"&
Rows.Count).End(xlUp).Row)'* determine the last filled row of FPM file
lstDPMRow = WorksheetFunction.Max(2, wbDPM.Sheets(1).Range("A"&
Rows.Count).End(xlUp).Row)'* determine the last filled row of DPM file
FPO1Row =1: FPO2Row =1: FPO3Row =1
OnErrorGoTo err_handler
Application.EnableCancelKey = xlErrorHandler
showProgressForm
For DPMRow =2To lstDPMRow
If DPMRow Mod50=0And lstDPMRow - DPMRow >50Then
tEnd = Format(time2End(lstDPMRow - DPMRow, DPMRow, tStart),"HH:mm:ss")
EndIf
Application.StatusBar ="PriceMapping Consolidation ... "& Format(DPMRow /
lstDPMRow,"#0.0%")& IIf(DPMRow >=50,Space(5)&"estimated completion time
remaining: "& tEnd,"")
If DPMRow >=50Then updateProgressMessage barMessage:="estimated completion time
remaining: "& tEnd
updateProgessBarForm iCount:=DPMRow, iTotal:=lstDPMRow
With wsFPM.Range("A:A")
Set FPMrng =.Find(What:=(wsDPM.Cells(DPMRow,1).Value), LookIn:=xlValues,
LookAt:=xlWhole)
IfNot FPMrng IsNothingThen
GoSub PMPartI
Else
GoSub PMPart2
EndIf
EndWith
If PressedState =TrueThen
SelectCase MsgBox("You have pressed 'Esc' or 'Cancel'!"& vbCrLf & vbCrLf & _
"Do you wish to stop the Price Mapping process?", vbExclamation + vbYesNo +
vbDefaultButton2,"STOP PRICEMAPPING PROCESS?")
CaseIs= vbYes:ExitFor
CaseElse
PressedState =False
EndSelect
EndIf
Next DPMRow
Err.Clear
OnErrorGoTo0
uldpbf
wsFPO1.Cells.Columns.AutoFit
wsFPO2.Cells.Columns.AutoFit
wsFPO3.Cells.Columns.AutoFit
GoTo endRoutine
PMPartI:
'* Part I: Price Information for System Upload where Price information is
available
FPMRow = FPMrng.Row
FPO1Row = FPO1Row +1
wsFPO1.Cells(FPO1Row,"A").Value = wsFPM.Cells(FPMRow,"C").Value '* sku
wsFPO1.Cells(FPO1Row,"B").Value =""'* ean
wsFPO1.Cells(FPO1Row,"C").Value = wsFPM.Cells(FPMRow,"D").Value '* name
wsFPO1.Cells(FPO1Row,"D").Value =""'* status
wsFPO1.Cells(FPO1Row,"E").Value = wsDPM.Cells(DPMRow,"C").Value '* price
wsFPO1.Cells(FPO1Row,"F").Value = wsDPM.Cells(DPMRow,"E").Value '* qty
wsFPO1.Cells(FPO1Row,"G").Value =""'* specialrice
If wsDPM.Cells(DPMRow,"D").Value < wsDPM.Cells(DPMRow,"C").Value Then _
wsFPO1.Cells(FPO1Row,"G").Value = wsDPM.Cells(DPMRow,"D").Value '* specialrice
wsFPO1.Cells(FPO1Row,"H").Value =""'* specialate start
wsFPO1.Cells(FPO1Row,"I").Value =""'* specialate end
Return
PMPart2:
'* Part II: New worksheet to populate all items from Sheet 1 where price
information was not found in Sheet 2
FPO2Row = FPO2Row +1
wsFPO2.Cells(FPO2Row,"A").Value = wsDPM.Cells(DPMRow,"A").Value '* sku
wsFPO2.Cells(FPO2Row,"B").Value =""'* ean
wsFPO2.Cells(FPO2Row,"C").Value = wsDPM.Cells(DPMRow,"B").Value '* name
wsFPO2.Cells(FPO2Row,"D").Value =""'* status
wsFPO2.Cells(FPO2Row,"E").Value = wsDPM.Cells(DPMRow,"C").Value '* price
wsFPO2.Cells(FPO2Row,"F").Value = wsDPM.Cells(DPMRow,"E").Value '* qty
wsFPO2.Cells(FPO2Row,"G").Value =""'* specialrice
wsFPO2.Cells(FPO2Row,"H").Value =""'* specialate start
wsFPO2.Cells(FPO2Row,"I").Value =""'* specialate end
Return
PMPart3:
'* Part III: New worksheet to populate all duplicate items from Sheet 1 where
price information was not found in Sheet 2
FPO3Row =1
'* no code written for this
Return
err_handler:
If Err.Number =18Then PressedState =True
Err.Clear
Resume
endRoutine:
wbFPO.Save
tStop = Format(Now(),"hh:mm:ss")
ProcOK =True
GoTo exitSub
exitNoGo:
With Application
.ScreenUpdating =True
.EnableEvents =True
.Calculation = xlCalculationAutomatic
.EnableCancelKey = xlInterrupt
EndWith
Application.ScreenUpdating =True
MsgBox "One or more data files was not found or is not available!",
vbExclamation,"OPERATION ABORTED"
exitSub:
Application.ScreenUpdating =True
Application.StatusBar =False
Err.Clear
OnErrorResumeNext
wbFPM.Close False
wbDPM.Close False
Set wbFPM =Nothing
Set wbDPM =Nothing
Set wbFPO =Nothing
Err.Clear
OnErrorGoTo0
SelectCase ProcOK
CaseIs=True
With wsTool
.Range("B2").ClearContents
.Range("B3").ClearContents
.Range("B4").ClearContents
.Range("B5").ClearContents
EndWith
MsgBox "Process started : "& tStart & vbCrLf & _
"Process ended at: "& tStop & vbCrLf & _
"Time elapsed: "& IIf(Hour(tStop)>= Hour(tStart), Format(tStop -
tStart,"hh:mm:ss"), _
Format((tmidnite - tStart)+ tStop,"hh:mm:ss")), vbInformation,"Price Mapping
completed sucessfully!"
CaseElse
MsgBox "Price Mapping not completed!", vbExclamation,"Price Mapping failed!"
EndSelect
wbTool.Save
EndSub
PublicFunction findAcronym(tVal AsVariant)AsString
Dim rng As Range
With Sheets("Merchants").Range("B:B")
Set rng =.Find(What:=tVal, LookIn:=xlValues, LookAt:=xlWhole)
IfNot rng IsNothingThen findAcronym = rng.Offset(0,-1).Value
EndWith
EndFunction
PublicFunction fillColumnHeaders(ws As Worksheet)
Dim colNames AsVariant
Dim i AsInteger
Dim x AsInteger
colNames = Split("sku|ean|name|status|price|quantity|specialrice|specialate
start|specialate end|","|")
With ws
x = WorksheetFunction.Max(1, LBound(colNames))
For i = LBound(colNames)To UBound(colNames)
.Cells(1, x).Value = colNames(i)
x = x +1
Next i
EndWith
EndFunction
PublicFunction timeElapsed(tStart AsDate)AsDouble
Dim tStop AsDate
Dim elapsed AsDate
tStop = Time
If Hour(tStop)< Hour(tStart)Then
elapsed =(TimeSerial(23,59,59)- tStart)+ tStop
Else
elapsed = tStop - tStart
EndIf
timeElapsed = elapsed '* 86400
EndFunction
PublicFunction time2End(totalRows AsLong, processedRows AsLong, tStart
AsDate)AsDouble
If Minute(tStart)=0Or processedRows =0Then time2End =0:ExitFunction
time2End =(totalRows * timeElapsed(tStart))/ processedRows
EndFunction
--
Are you =EXP(E:RT) or =NOT(EXP(E:RT)) in Excel? And do you wanna be? It’s
=TIME(2,DO:IT,N:OW) ! Join official Facebook page of this forum @
https://www.facebook.com/discussexcel
FORUM RULES
1) Use concise, accurate thread titles. Poor thread titles, like Please Help,
Urgent, Need Help, Formula Problem, Code Problem, and Need Advice will not get
quick attention or may not be answered.
2) Don't post a question in the thread of another member.
3) Don't post questions regarding breaking or bypassing any security measure.
4) Acknowledge the responses you receive, good or bad.
5) Jobs posting is not allowed.
6) Sharing copyrighted material and their links is not allowed.
NOTE : Don't ever post confidential data in a workbook. Forum owners and
members are not responsible for any loss.
---
You received this message because you are subscribed to the Google Groups "MS
EXCEL AND VBA MACROS" group.
To unsubscribe from this group and stop receiving emails from it, send an email
to excel-macros+unsubscr...@googlegroups.com.
To post to this group, send email to excel-macros@googlegroups.com.
Visit this group at https://groups.google.com/group/excel-macros.
For more options, visit https://groups.google.com/d/optout.
--
Are you =EXP(E:RT) or =NOT(EXP(E:RT)) in Excel? And do you wanna be? It’s
=TIME(2,DO:IT,N:OW) ! Join official Facebook page of this forum @
https://www.facebook.com/discussexcel
FORUM RULES
1) Use concise, accurate thread titles. Poor thread titles, like Please Help,
Urgent, Need Help, Formula Problem, Code Problem, and Need Advice will not get
quick attention or may not be answered.
2) Don't post a question in the thread of another member.
3) Don't post questions regarding breaking or bypassing any security measure.
4) Acknowledge the responses you receive, good or bad.
5) Jobs posting is not allowed.
6) Sharing copyrighted material and their links is not allowed.
NOTE : Don't ever post confidential data in a workbook. Forum owners and
members are not responsible for any loss.
---
You received this message because you are subscribed to the Google Groups "MS
EXCEL AND VBA MACROS" group.
To unsubscribe from this group and stop receiving emails from it, send an email
to excel-macros+unsubscr...@googlegroups.com.
To post to this group, send email to excel-macros@googlegroups.com.
Visit this group at https://groups.google.com/group/excel-macros.
For more options, visit https://groups.google.com/d/optout.
