transforming data into a single format/file
Sorry, the problem was simple to fix. One line was in the wrong location.
Move the line DataCol below the Do statement like below (previously it was
above the Do statement).
Do While .Range("A" & OldRowCount) < ""
DataCol = .Range(StartDataCol & 1).Column
"C02C04" wrote:
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
|