Home Menu

Menu


ExcelBanter » Excel Newsgroups » Excel Programming > transforming data into a single format/file
Reply
 
LinkBack Thread Tools Search this Thread Display Modes
  #1   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 25
Default transforming data into a single format/file
Seeking help here as I'm not good at VBA. This situation is about tranforming
data from user into a single output file with structured column format.
There are 3 files (C, Q and W) from user. They look similar but columns and
rows setup are slightly different. Each of these files represent data from a
supplier. I would like to tranform them into a single output file and adding
a column to identify the Supplier.

Below are details of the files and some sample data. Let me know if further
info is required. I'm looking for a fully automated process/VBA where the
output file is generated as soon as the C,Q and W files are available.

Thanks.


C.xls format:
Col A is Platform Name
Col B is Region
Col C is Unused
Col D onwards are data with Row 1 as Month and Row 2 as Week.

Col A Col B Col C Col D Col E Col F Col G Col H
Row1 DEC DEC DEC DEC JAN
Row2 Week44 Week45 Week46 Week47 Week48
Row3 Platform01 US F1 0 0 0 0 0
Row4 Platform02 US F4 3,844 5,064 5,613 3,822 2,283
Row5 Platform03 US F4 11,339 14,939 16,559 11,275 8,302
Row6 Platform04 US F4 0 0 0 0 0

Q.xls format:
Col A is Region
Col B is Platform Name
Col C is Unused
Col D is Type Name
Col E onwards are data with Row 4 as Month and Row 5 as Week.


Row1 Col A Col B Col C Col D Col E Col F Col G Col H
Row2
Row3
Row4 DEC DEC DEC DEC
Row5 Week44 Week45 Week46 Week47
Row6 US Platform01 OM - - - -
Row7 US Platform02 OM - - - -
Row8 US Platform04 OM 5,392 7,103 7,874 5,361
Row9 US Platform05 OM 5,228 6,887 7,634 5,198
Row10 US Platform06 OM 6,052 7,973 8,837 6,018


W.xls format:
Col A is Region
Col B is Platform Name
Col C is Config
Col D is Type Name
Col E onwards are data with Row 1 as Month and Row 2 as Week.

Col A Col B Col C Col D Col E Col F Col G Col H
Row1 DEC Dec Dec Dec
Row2 Week44 Week45 Week46 Week47
Row3 US Platform03 CTO OM 0 0 0 0
Row4 US Platform04 CTO OM 1,922 2,532 2,807 1,911
Row5 US Platform04 BTS OM 1,153 1,519 1,684 1,147
Row6 US Platform01 CTO OM 0 0 0 0
Row7 US Platform05 BTS OM 15,375 20,257 22,453 15,289
Row8 EMEA Platform03 CTO OM 0 0 0 0


Desired Output.xls format:
The Supplier column is taking on the file name (C, W or Q) provided by user.

Region Platform Config Supplier MONTH WEEK QTY
US Platform01 CTO W SEP Week31 5982.608544
US Platform01 CTO W SEP Week32 5801.804102
US Platform01 CTO W SEP Week33 6955.543465
US Platform01 CTO W SEP Week34 7260.043889
US Platform01 CTO W OCT Week35 4949.034663
US Platform01 CTO W OCT Week36 4743.036811
US Platform01 CTO W OCT Week37 5790.307877

Reply With QuoteReply With Quote
  #2   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 9,101
Default transforming data into a single format/file
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


"C02C04" wrote:

Seeking help here as I'm not good at VBA. This situation is about tranforming
data from user into a single output file with structured column format.
There are 3 files (C, Q and W) from user. They look similar but columns and
rows setup are slightly different. Each of these files represent data from a
supplier. I would like to tranform them into a single output file and adding
a column to identify the Supplier.

Below are details of the files and some sample data. Let me know if further
info is required. I'm looking for a fully automated process/VBA where the
output file is generated as soon as the C,Q and W files are available.

Thanks.


C.xls format:
Col A is Platform Name
Col B is Region
Col C is Unused
Col D onwards are data with Row 1 as Month and Row 2 as Week.

Col A Col B Col C Col D Col E Col F Col G Col H
Row1 DEC DEC DEC DEC JAN
Row2 Week44 Week45 Week46 Week47 Week48
Row3 Platform01 US F1 0 0 0 0 0
Row4 Platform02 US F4 3,844 5,064 5,613 3,822 2,283
Row5 Platform03 US F4 11,339 14,939 16,559 11,275 8,302
Row6 Platform04 US F4 0 0 0 0 0

Q.xls format:
Col A is Region
Col B is Platform Name
Col C is Unused
Col D is Type Name
Col E onwards are data with Row 4 as Month and Row 5 as Week.


Row1 Col A Col B Col C Col D Col E Col F Col G Col H
Row2
Row3
Row4 DEC DEC DEC DEC
Row5 Week44 Week45 Week46 Week47
Row6 US Platform01 OM - - - -
Row7 US Platform02 OM - - - -
Row8 US Platform04 OM 5,392 7,103 7,874 5,361
Row9 US Platform05 OM 5,228 6,887 7,634 5,198
Row10 US Platform06 OM 6,052 7,973 8,837 6,018


W.xls format:
Col A is Region
Col B is Platform Name
Col C is Config
Col D is Type Name
Col E onwards are data with Row 1 as Month and Row 2 as Week.

Col A Col B Col C Col D Col E Col F Col G Col H
Row1 DEC Dec Dec Dec
Row2 Week44 Week45 Week46 Week47
Row3 US Platform03 CTO OM 0 0 0 0
Row4 US Platform04 CTO OM 1,922 2,532 2,807 1,911
Row5 US Platform04 BTS OM 1,153 1,519 1,684 1,147
Row6 US Platform01 CTO OM 0 0 0 0
Row7 US Platform05 BTS OM 15,375 20,257 22,453 15,289
Row8 EMEA Platform03 CTO OM 0 0 0 0


Desired Output.xls format:
The Supplier column is taking on the file name (C, W or Q) provided by user.

Region Platform Config Supplier MONTH WEEK QTY
US Platform01 CTO W SEP Week31 5982.608544
US Platform01 CTO W SEP Week32 5801.804102
US Platform01 CTO W SEP Week33 6955.543465
US Platform01 CTO W SEP Week34 7260.043889
US Platform01 CTO W OCT Week35 4949.034663
US Platform01 CTO W OCT Week36 4743.036811
US Platform01 CTO W OCT Week37 5790.307877

Reply With QuoteReply With Quote
  #3   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 25
Default transforming data into a single format/file
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


"C02C04" wrote:

Seeking help here as I'm not good at VBA. This situation is about tranforming
data from user into a single output file with structured column format.
There are 3 files (C, Q and W) from user. They look similar but columns and
rows setup are slightly different. Each of these files represent data from a
supplier. I would like to tranform them into a single output file and adding
a column to identify the Supplier.

Below are details of the files and some sample data. Let me know if further
info is required. I'm looking for a fully automated process/VBA where the
output file is generated as soon as the C,Q and W files are available.

Thanks.


C.xls format:
Col A is Platform Name
Col B is Region
Col C is Unused
Col D onwards are data with Row 1 as Month and Row 2 as Week.

Col A Col B Col C Col D Col E Col F Col G Col H
Row1 DEC DEC DEC DEC JAN
Row2 Week44 Week45 Week46 Week47 Week48
Row3 Platform01 US F1 0 0 0 0 0
Row4 Platform02 US F4 3,844 5,064 5,613 3,822 2,283
Row5 Platform03 US F4 11,339 14,939 16,559 11,275 8,302
Row6 Platform04 US F4 0 0 0 0 0

Q.xls format:
Col A is Region
Col B is Platform Name
Col C is Unused
Col D is Type Name
Col E onwards are data with Row 4 as Month and Row 5 as Week.


Row1 Col A Col B Col C Col D Col E Col F Col G Col H
Row2
Row3
Row4 DEC DEC DEC DEC
Row5 Week44 Week45 Week46 Week47
Row6 US Platform01 OM - - - -
Row7 US Platform02 OM - - - -
Row8 US Platform04 OM 5,392 7,103 7,874 5,361
Row9 US Platform05 OM 5,228 6,887 7,634 5,198
Row10 US Platform06 OM 6,052 7,973 8,837 6,018


W.xls format:
Col A is Region
Col B is Platform Name
Col C is Config
Col D is Type Name
Col E onwards are data with Row 1 as Month and Row 2 as Week.

Col A Col B Col C Col D Col E Col F Col G Col H
Row1 DEC Dec Dec Dec
Row2 Week44 Week45 Week46 Week47
Row3 US Platform03 CTO OM 0 0 0 0
Row4 US Platform04 CTO OM 1,922 2,532 2,807 1,911
Row5 US Platform04 BTS OM 1,153 1,519 1,684 1,147
Row6 US Platform01 CTO OM 0 0 0 0
Row7 US Platform05 BTS OM 15,375 20,257 22,453 15,289
Row8 EMEA Platform03 CTO OM 0 0 0 0


Desired Output.xls format:
The Supplier column is taking on the file name (C, W or Q) provided by user.

Region Platform Config Supplier MONTH WEEK QTY
US Platform01 CTO W SEP Week31 5982.608544
US Platform01 CTO W SEP Week32 5801.804102
US Platform01 CTO W SEP Week33 6955.543465
US Platform01 CTO W SEP Week34 7260.043889
US Platform01 CTO W OCT Week35 4949.034663
US Platform01 CTO W OCT Week36 4743.036811
US Platform01 CTO W OCT Week37 5790.307877

Reply With QuoteReply With Quote
  #4   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 9,101
Default transforming data into a single format/file
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


"C02C04" wrote:

Seeking help here as I'm not good at VBA. This situation is about tranforming
data from user into a single output file with structured column format.
There are 3 files (C, Q and W) from user. They look similar but columns and
rows setup are slightly different. Each of these files represent data from a
supplier. I would like to tranform them into a single output file and adding
a column to identify the Supplier.

Below are details of the files and some sample data. Let me know if further
info is required. I'm looking for a fully automated process/VBA where the
output file is generated as soon as the C,Q and W files are available.

Thanks.


C.xls format:
Col A is Platform Name
Col B is Region
Col C is Unused
Col D onwards are data with Row 1 as Month and Row 2 as Week.

Col A Col B Col C Col D Col E Col F Col G Col H
Row1 DEC DEC DEC DEC JAN
Row2 Week44 Week45 Week46 Week47 Week48
Row3 Platform01 US F1 0 0 0 0 0
Row4 Platform02 US F4 3,844 5,064 5,613 3,822 2,283
Row5 Platform03 US F4 11,339 14,939 16,559 11,275 8,302
Row6 Platform04 US F4 0 0 0 0 0

Q.xls format:
Col A is Region
Col B is Platform Name
Col C is Unused
Col D is Type Name
Col E onwards are data with Row 4 as Month and Row 5 as Week.


Row1 Col A Col B Col C Col D Col E Col F Col G Col H
Row2
Row3
Row4 DEC DEC DEC DEC
Row5 Week44 Week45 Week46 Week47
Row6 US Platform01 OM - - - -
Row7 US Platform02 OM - - - -
Row8 US Platform04 OM 5,392 7,103 7,874 5,361
Row9 US Platform05 OM 5,228 6,887 7,634 5,198
Row10 US Platform06 OM 6,052 7,973 8,837 6,018


W.xls format:
Col A is Region
Col B is Platform Name
Col C is Config
Col D is Type Name
Col E onwards are data with Row 1 as Month and Row 2 as Week.

Col A Col B Col C Col D Col E Col F Col G Col H
Row1 DEC Dec Dec Dec
Row2 Week44 Week45 Week46 Week47
Row3 US Platform03 CTO OM 0 0 0 0
Row4 US Platform04 CTO OM 1,922 2,532 2,807 1,911
Row5 US Platform04 BTS OM 1,153 1,519 1,684 1,147
Row6 US Platform01 CTO OM 0 0 0 0
Row7 US Platform05 BTS OM 15,375 20,257 22,453 15,289
Row8 EMEA Platform03 CTO OM 0 0 0 0


Desired Output.xls format:
The Supplier column is taking on the file name (C, W or Q) provided by user.

Region Platform Config Supplier MONTH WEEK QTY
US Platform01 CTO W SEP Week31 5982.608544
US Platform01 CTO W SEP Week32 5801.804102
US Platform01 CTO W SEP Week33 6955.543465
US Platform01 CTO W SEP Week34 7260.043889
US Platform01 CTO W OCT Week35 4949.034663
US Platform01 CTO W OCT Week36 4743.036811
US Platform01 CTO W OCT Week37 5790.307877

Reply With QuoteReply With Quote
  #5   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 25
Default transforming data into a single format/file
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


Reply With QuoteReply With Quote
  #6   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 9,101
Default 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
Reply With QuoteReply With Quote
  #7   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 25
Default transforming data into a single format/file
Thanks a million Joel! Works like a charm!


"Joel" wrote:

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)
Reply With QuoteReply With Quote
  #8   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 9,101
Default transforming data into a single format/file
I keep on forgetting to let you know that the file isn't being saved at the
end of the macro. Add the line below.


OldBk.Close savechanges:=False

NewBk.Save '<==========Add this line

End Sub

Sub WriteData(NewSht, OldSht, _
ByRef NewRowCount, StartRow, StartDataCol, _
Supplier, RegionCol, PlatformCol, ConfigCol)


"C02C04" wrote:

Thanks a million Joel! Works like a charm!


"Joel" wrote:

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, _
Reply With QuoteReply With Quote
  #9   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 25
Default transforming data into a single format/file
Joel
Not a big issue. Thanks for the follow up.

On that note, I noticed if I used the same file name a brand new file is
created/over-written. I need to create a few columns like fiscal quarter,
fiscal year etc using vlookup. Would it be possible to copy the 7 columns
output to another file, say MasterData tab column A to G? My vlookup will be
in column H onwards. I will build pivot tables on these columns. I then
Refresh all pivots and the reports will be ready. I can manually do all
these actions (copy and paste, refresh all) but fully automated macro would
be nice.

C02C04

"Joel" wrote:

I keep on forgetting to let you know that the file isn't being saved at the
end of the macro. Add the line below.


OldBk.Close savechanges:=False

NewBk.Save '<==========Add this line

End Sub

Sub WriteData(NewSht, OldSht, _
ByRef NewRowCount, StartRow, StartDataCol, _
Supplier, RegionCol, PlatformCol, ConfigCol)


"C02C04" wrote:

Thanks a million Joel! Works like a charm!


"Joel" wrote:

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"
Reply With QuoteReply With Quote
  #10   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 9,101
Default transforming data into a single format/file
I would recommend recording a macro when doing these manual operations. I
usually make some minor adjustments to the recorded macros. Record a macro
and I will make these changes.

1) Start Recording - Tools - Macro - Record new macro
2) Perform your manual operations.
3) Stop Recording - Tools - Macro - Stop Recording.

"C02C04" wrote:

Joel
Not a big issue. Thanks for the follow up.

On that note, I noticed if I used the same file name a brand new file is
created/over-written. I need to create a few columns like fiscal quarter,
fiscal year etc using vlookup. Would it be possible to copy the 7 columns
output to another file, say MasterData tab column A to G? My vlookup will be
in column H onwards. I will build pivot tables on these columns. I then
Refresh all pivots and the reports will be ready. I can manually do all
these actions (copy and paste, refresh all) but fully automated macro would
be nice.

C02C04

"Joel" wrote:

I keep on forgetting to let you know that the file isn't being saved at the
end of the macro. Add the line below.


OldBk.Close savechanges:=False

NewBk.Save '<==========Add this line

End Sub

Sub WriteData(NewSht, OldSht, _
ByRef NewRowCount, StartRow, StartDataCol, _
Supplier, RegionCol, PlatformCol, ConfigCol)


"C02C04" wrote:

Thanks a million Joel! Works like a charm!


"Joel" wrote:

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
Reply With QuoteReply With Quote
Reply
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes
Linear Mode Linear Mode

Posting Rules
Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On

Similar Threads
Thread Thread Starter Forum Replies Last Post
transforming rank data David Schwartz Excel Discussion (Misc queries) 3 January 31st 09 06:33 PM
Capture data in one 'destination' file from varied 'source' file stored in one single folder. Smits Excel Programming 4 October 7th 06 12:35 PM
Data transforming and zigzag figure poltting yoyo2000 Excel Discussion (Misc queries) 0 September 13th 05 05:22 PM
Transforming Data Murtaza Links and Linking in Excel 4 August 23rd 05 07:19 PM
Transforming Excel data to Xml viswas_p Excel Programming 1 October 5th 04 05:30 PM


All times are GMT +1. The time now is 10:27 PM.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
Copyright ©2004-2024 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"

 

Contact Us ExcelBanter forum home Privacy Statement