Home |
Search |
Today's Posts |
#5
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]()
Thanks Joe for making the changes. On close examination of the output file it
seems only 1 row is captured from each input file. Taking C file as an example, it has a couple of Platforms and other regions like Japan, EMEA and APeJ (samples below). I could only see US region for Platform01 under Supplier C in the output file. What needs to change in the coding? C02C04 DEC Week44 Platform01 US F1 0 Platform02 US F4 3,844 Platform03 US F4 11,339 Platform04 US F4 0 Platform03 RETAIL US F4 0 Platform01 EMEA F4 0 Platform02 EMEA F4 6,588 Platform02 RETAIL EMEA F4 8,862 Platform03 EMEA F4 Platform02 JAPAN F4 932 Platform02 RETAIL JAPAN F4 260 Platform03 JAPAN F4 0 Platform03 RETAIL JAPAN F4 0 Platform01 APeJ F4 0 Platform01 RETAIL APeJ F4 0 Platform02 APeJ F4 1,095 Platform02 RETAIL APeJ F4 0 Platform03 APeJ F4 1 Platform03 RETAIL APeJ F4 0 "Joel" wrote: Sub CombineData() CFname = Application _ .GetOpenFilename( _ fileFilter:="Excel Files (*.xls), *.xls", _ Title:="Open C File") If CFname = False Then MsgBox ("Cannot open file - exiting macro") Exit Sub End If QFname = Application _ .GetOpenFilename( _ fileFilter:="Excel Files (*.xls), *.xls", _ Title:="Open Q File") If QFname = False Then MsgBox ("Cannot open file - exiting macro") Exit Sub End If WFname = Application _ .GetOpenFilename( _ fileFilter:="Excel Files (*.xls), *.xls", _ Title:="Open W File") If WFname = False Then MsgBox ("Cannot open file - exiting macro") Exit Sub End If filesavename = Application.GetSaveAsFilename( _ fileFilter:="Excel Files (*.xls), *.xls") If filesavename = False Then MsgBox ("Cannot Save file - Exiting macro") Exit Sub End If Set NewBk = Workbooks.Add NewBk.SaveAs Filename:=filesavename Set NewSht = NewBk.Sheets("Sheet1") With NewSht .Range("A1") = "Region" .Range("B1") = "Platform" .Range("C1") = "Config" .Range("D1") = "Supplier" .Range("E1") = "MONTH" .Range("F1") = "WEEK" .Range("G1") = "QT" NewRowCount = 2 End With Set OldBk = Workbooks.Open(Filename:=CFname) Set OldSht = OldBk.Sheets("Latest") StartRow = 1 StartDataCol = "D" RegionCol = "B" PlatformCol = "A" ConfigCol = "C" 'Use unused column - no config BaseName = StrReverse(CFname) BaseName = Mid(BaseName, InStr(BaseName, ".") + 1) BaseName = Left(BaseName, InStr(BaseName, "\") - 1) BaseName = StrReverse(BaseName) Supplier = BaseName Call WriteData(NewSht, OldSht, _ NewRowCount, StartRow, StartDataCol, _ Supplier, RegionCol, PlatformCol, ConfigCol) OldBk.Close savechanges:=False Set OldBk = Workbooks.Open(Filename:=QFname) Set OldSht = OldBk.Sheets("Latest") StartRow = 4 StartDataCol = "E" RegionCol = "A" PlatformCol = "B" ConfigCol = "C" 'Use unused column - no config BaseName = StrReverse(QFname) BaseName = Mid(BaseName, InStr(BaseName, ".") + 1) BaseName = Left(BaseName, InStr(BaseName, "\") - 1) BaseName = StrReverse(BaseName) Supplier = BaseName Call WriteData(NewSht, OldSht, _ NewRowCount, StartRow, StartDataCol, _ Supplier, RegionCol, PlatformCol, ConfigCol) OldBk.Close savechanges:=False Set OldBk = Workbooks.Open(Filename:=WFname) Set OldSht = OldBk.Sheets("Latest") StartRow = 1 StartDataCol = "E" RegionCol = "A" PlatformCol = "B" ConfigCol = "C" BaseName = StrReverse(WFname) BaseName = Mid(BaseName, InStr(BaseName, ".") + 1) BaseName = Left(BaseName, InStr(BaseName, "\") - 1) BaseName = StrReverse(BaseName) Supplier = BaseName Call WriteData(NewSht, OldSht, _ NewRowCount, StartRow, StartDataCol, _ Supplier, RegionCol, PlatformCol, ConfigCol) OldBk.Close savechanges:=False End Sub Sub WriteData(NewSht, OldSht, _ ByRef NewRowCount, StartRow, StartDataCol, _ Supplier, RegionCol, PlatformCol, ConfigCol) With OldSht OldRowCount = StartRow + 2 'skip month and week rows DataCol = .Range(StartDataCol & 1).Column Do While .Range("A" & OldRowCount) < "" Region = .Range(RegionCol & OldRowCount) Platform = .Range(PlatformCol & OldRowCount) Config = .Range(ConfigCol & OldRowCount) Do While .Cells(StartRow, DataCol) < "" Mon = .Cells(StartRow, DataCol) Wk = .Cells(StartRow + 1, DataCol) QTY = .Cells(OldRowCount, DataCol) With NewSht .Range("A" & NewRowCount) = Region .Range("B" & NewRowCount) = Platform .Range("C" & NewRowCount) = Config .Range("D" & NewRowCount) = Supplier .Range("E" & NewRowCount) = Mon .Range("F" & NewRowCount) = Wk .Range("G" & NewRowCount) = QTY End With NewRowCount = NewRowCount + 1 DataCol = DataCol + 1 Loop OldRowCount = OldRowCount + 1 Loop End With End Sub "C02C04" wrote: Thanks Joel for your quick response. I copy the coding into a new file and save as macro.xlsm. I then Run the macro. I was asked to open C, Q and W files. I like this feature as it provides the flexibility to locate the files that might not be in the same folder. Then I provide a file name in the Save As dialog. Next, a dialog box with "Enter Supplier Name" pop up. I entered C. The result of the macro continues and a output file was produced. The format is what I needed which is GREAT. However, in the Supplier column it has the value of C. What I was hoping is the Supplier name is populated with the file name. For example, all the data in C file is transformed and in the Supplier column will be the file name, C. Likewise, all data in Q will be tranformed and in the Supplier column will be Q. Good to have the user input but then I will need to provide the same for each file. I don't mind keeping it simple by just taking on the file name for the supplier column. One additional request, if possible. Each of the input file has multiple tabs due to different date version. I will rename the most recent version as "Latest". Would it be possible to modify the coding to accomodate this? Otherwise, I will keep it as sheet1. C02C04 "Joel" wrote: Try this macro. Sub CombineData() CFname = Application _ .GetOpenFilename( _ fileFilter:="Excel Files (*.xls), *.xls", _ Title:="Open C File") If CFname = False Then MsgBox ("Cannot open file - exiting macro") Exit Sub End If QFname = Application _ .GetOpenFilename( _ fileFilter:="Excel Files (*.xls), *.xls", _ Title:="Open Q File") If QFname = False Then MsgBox ("Cannot open file - exiting macro") Exit Sub End If WFname = Application _ .GetOpenFilename( _ fileFilter:="Excel Files (*.xls), *.xls", _ Title:="Open W File") If WFname = False Then MsgBox ("Cannot open file - exiting macro") Exit Sub End If filesavename = Application.GetSaveAsFilename( _ fileFilter:="Excel Files (*.xls), *.xls") If filesavename = False Then MsgBox ("Cannot Save file - Exiting macro") Exit Sub End If Supplier = InputBox("Enter Supplier Name : ") Set NewBk = Workbooks.Add NewBk.SaveAs Filename:=filesavename Set NewSht = NewBk.Sheets("Sheet1") With NewSht .Range("A1") = "Region" .Range("B1") = "Platform" .Range("C1") = "Config" .Range("D1") = "Supplier" .Range("E1") = "MONTH" .Range("F1") = "WEEK" .Range("G1") = "QT" NewRowCount = 2 End With Set OldBk = Workbooks.Open(Filename:=CFname) Set OldSht = OldBk.Sheets("Sheet1") StartRow = 1 StartDataCol = "D" RegionCol = "B" PlatformCol = "A" ConfigCol = "C" 'Use unused column - no config Call WriteData(NewSht, OldSht, _ NewRowCount, StartRow, StartDataCol, _ Supplier, RegionCol, PlatformCol, ConfigCol) OldBk.Close savechanges:=False Set OldBk = Workbooks.Open(Filename:=QFname) Set OldSht = OldBk.Sheets("Sheet1") StartRow = 4 StartDataCol = "E" RegionCol = "A" PlatformCol = "B" ConfigCol = "C" 'Use unused column - no config Call WriteData(NewSht, OldSht, _ NewRowCount, StartRow, StartDataCol, _ Supplier, RegionCol, PlatformCol, ConfigCol) OldBk.Close savechanges:=False Set OldBk = Workbooks.Open(Filename:=WFname) Set OldSht = OldBk.Sheets("Sheet1") StartRow = 1 StartDataCol = "E" RegionCol = "A" PlatformCol = "B" ConfigCol = "C" Call WriteData(NewSht, OldSht, _ NewRowCount, StartRow, StartDataCol, _ Supplier, RegionCol, PlatformCol, ConfigCol) OldBk.Close savechanges:=False End Sub Sub WriteData(NewSht, OldSht, _ ByRef NewRowCount, StartRow, StartDataCol, _ Supplier, RegionCol, PlatformCol, ConfigCol) With OldSht OldRowCount = StartRow + 2 'skip month and week rows DataCol = .Range(StartDataCol & 1).Column Do While .Range("A" & OldRowCount) < "" Region = .Range(RegionCol & OldRowCount) Platform = .Range(PlatformCol & OldRowCount) Config = .Range(ConfigCol & OldRowCount) Do While .Cells(StartRow, DataCol) < "" Mon = .Cells(StartRow, DataCol) Wk = .Cells(StartRow + 1, DataCol) QTY = .Cells(OldRowCount, DataCol) With NewSht .Range("A" & NewRowCount) = Region .Range("B" & NewRowCount) = Platform .Range("C" & NewRowCount) = Config .Range("D" & NewRowCount) = Supplier .Range("E" & NewRowCount) = Mon .Range("F" & NewRowCount) = Wk .Range("G" & NewRowCount) = QTY End With NewRowCount = NewRowCount + 1 DataCol = DataCol + 1 Loop OldRowCount = OldRowCount + 1 Loop End With End Sub |
Thread Tools | Search this Thread |
Display Modes | |
|
|
![]() |
||||
Thread | Forum | |||
transforming rank data | Excel Discussion (Misc queries) | |||
Capture data in one 'destination' file from varied 'source' file stored in one single folder. | Excel Programming | |||
Data transforming and zigzag figure poltting | Excel Discussion (Misc queries) | |||
Transforming Data | Links and Linking in Excel | |||
Transforming Excel data to Xml | Excel Programming |