VBA to Import Data from one file to another and transpose paste it.

[chetanojha]

Dear Forum Members,

I have a situation where I receive a lot of files from different sales depots to me on daily basis. These files are identical in nature. All files have three worksheets namely Depot Name, Operator and Order_Details. Only one column (in “Order_Details” worksheet) keeps changing. This “Order_Details” worksheet typically looks like below:

Entity	Description	Values
Deport Name	Name of the Depot	London
Truck Entry	Time when truck entered	01/12/2017 01:45:34
Truck Exit	Time when truck exited	01/12/2017 04:45:34
Total Time Take	Total Time in despatch	03:00:00 Hours
Operator	Name of the Operator	Alan
Operator Average	Average time of the operator	2.45 hours
Total Weight	Weight of the truck when exit	11 Tonnes
Total Sale value	Total Sale Value	$15000
Order Status	Is Order Completed	Completed

<tbody>
</tbody>

Now, I have a master excel sheet (Consolidate_Orders.xls) where I load all this information, received above from Order_Details worksheet, manually at the moment. This Consolidate_Orders.xls workbook looks like below. This workbook consolidates all the files which I receive daily from different depots.

Deport Name	Truck Entry	Truck Exit	Total Time Taken	Operator	Operator Average	Total Weight	Total Sale value	Order Status
London	01/12/2017 01:45:34	01/12/2017 04:45:34	03:00:00 Hours	Alan	2.45 hours	11 Tonnes	15000	Completed
Manchester	01/12/2017 01:45:34	01/12/2017 04:45:34	03:00:00 Hours	Michael	2.45 hours	12 Tonnes	1800	Completed
Swindon	01/12/2017 01:45:34	01/12/2017 04:45:34	03:00:00 Hours	Elaine	2.45 hours	13 Tonnes	2000	Completed
Swansea	01/12/2017 01:45:34	01/12/2017 04:45:34	03:00:00 Hours	Julie	2.45 hours	14 Tonnes	50000	Completed

<tbody>
</tbody>

My requirement is to have a button in the Consolidate_Orders.xls workbook/worksheet – which will then open a dialog box to ask me which file I need to import into the Consolidate_Orders.xls workbook. I will then select London_Depot file (as shown above). Once London_Depot file is selected, data from the worksheet “ORDER_DETAILS” (column name “VALUES” ) will be copied and transpose pasted in the end of the Consolidate_Orders.xls file

I checked this forum and also googled it. There are lot of material.. but I cannot make much sense of it.

Any help would be appreciated.

Thanks a lot

 

[ranman256]

I dont think Excel can do this type of pivot.

Microsoft Access can do this in a single crosstab query.
you would import in the excel data as a table
a macro would have to define the start and end of each record
then the 'pivot table' (crosstab query ) would run to display what you need.

Simple for Access user, but not so for a novice, BUT do-able.

TRANSFORM First(xlShipping.Values) AS FirstOfValues
SELECT xlShipping.RecNum
FROM xlShipping
GROUP BY xlShipping.RecNum
PIVOT xlShipping.Entity;

 

[Fluff]

Hi, how about this

Sub OpenCopyTrans()

   Dim Fname As String
   Dim Wbk As Workbook
   Dim Sht As Worksheet
   
   Set Sht = ActiveSheet
   Fname = Application.GetOpenFilename("Excel files (*.xls*), *.xls*", , "select a File", , False)
   Set Wbk = Workbooks.Open(Fname)
   
   Sht.Range("A" & Sht.Rows.Count).End(xlUp).Offset(1).Resize(1, 9).value = _
   Application.Transpose(Wbk.Sheets("Order_Details").Range("C2:C10").value)
   Wbk.Close False
   
   
End Sub

It assumes that data on both sheets starts in A1

 

[chetanojha]

Brilliant..!! This worked perfectly. I am now able to move the column from one excel and transpose it to another as row. The only snag is for the file-open dialog box... when i click "cancel" instead of selecting the file... I am getting debug error. But when i select the file.... all works fine.

Hi, how about this

Sub OpenCopyTrans()

   Dim Fname As String
   Dim Wbk As Workbook
   Dim Sht As Worksheet
   
   Set Sht = ActiveSheet
   Fname = Application.GetOpenFilename("Excel files (*.xls*), *.xls*", , "select a File", , False)
   Set Wbk = Workbooks.Open(Fname)
   
   Sht.Range("A" & Sht.Rows.Count).End(xlUp).Offset(1).Resize(1, 9).value = _
   Application.Transpose(Wbk.Sheets("Order_Details").Range("C2:C10").value)
   Wbk.Close False
   
   
End Sub

It assumes that data on both sheets starts in A1

 

[Fluff]

The only snag is for the file-open dialog box... when i click "cancel" instead of selecting the file... I am getting debug error.

Simple, don't click cancel

Alternatively, add the line in blue

Sub OpenCopyTrans()

   Dim Fname As String
   Dim Wbk As Workbook
   Dim Sht As Worksheet
   
   Set Sht = ActiveSheet
   Fname = Application.GetOpenFilename("Excel files (*.xls*), *.xls*", , "select a File", , False)
  [COLOR=#0000ff] If Fname = "False" Then Exit Sub[/COLOR]
   Set Wbk = Workbooks.Open(Fname)
   
   Sht.Range("A" & Sht.Rows.Count).End(xlUp).Offset(1).Resize(1, 9).Value = _
   Application.Transpose(Wbk.Sheets("Order_Details").Range("C2:C10").Value)
   Wbk.Close False
   
   
End Sub

 

[chetanojha]

Hi Fluff,

Thanks for your quick replies and helping me out for these. Just as the final result of the excel is taking place.. I have few more cosmetic queries...


1. Is there any way that code copy the format of the above row before transposing the content into the next row? This is to make sure I do not have to manually adjust the format of the newly pasted row.
2. From the code is there a way to find the Row Number on which we are pasting the data?
3. I receive files with three different naming convention. I want to extract string from the filename to identify the from where orders are coming to me.
a. For Filename "ORD Load ORDERS - ORD-DL-LOND-003.xls" -- (If the filename contains DL, I need to extract “ORD-DL-LOND-003” from the filename and put into column A)
b. For Filename "ORD-OL-003 (SWA 10.16).xls" -- (If the filename contains OL, I need to extract “ORD-OL-LOND-003(SWA 10.16)” from the filename and put into column A)
c. For Filename "ORD Load ORDERS - ORD-OFF-002.xls" -- (If the filename contains OFF, I need to extract “ORD-OFF-002” from the filename and put into column A)


Thanks a ton in advance for this.

Simple, don't click cancel

Alternatively, add the line in blue

Sub OpenCopyTrans()

   Dim Fname As String
   Dim Wbk As Workbook
   Dim Sht As Worksheet
   
   Set Sht = ActiveSheet
   Fname = Application.GetOpenFilename("Excel files (*.xls*), *.xls*", , "select a File", , False)
  [COLOR=#0000ff] If Fname = "False" Then Exit Sub[/COLOR]
   Set Wbk = Workbooks.Open(Fname)
   
   Sht.Range("A" & Sht.Rows.Count).End(xlUp).Offset(1).Resize(1, 9).Value = _
   Application.Transpose(Wbk.Sheets("Order_Details").Range("C2:C10").Value)
   Wbk.Close False
   
   
End Sub

 

[Fluff]

1) The macro is only copying values, so if you setup the format you want in the consolidated file, that format should be preserved.
2) Yes, what do you want to do with it?
3) Doable, will the file name contain only DL, OL, or OFF (ie can never have 2 or all 3 of those values)?
Do you want to overwrite the depot name, with these values?

 

[chetanojha]

Hi Fluff,

1. When I set the format of the files based on previous rows format... my row count goes haywire. I am using RowNumber = Sht.Cells(65535, 4).End(xlUp).Row to count the total rows in the excel (not the row in which I have pasted data). The idea of this is to put this row number in a separate index worksheet. So that I know which row in the Order_Details worksheet was pasted on which date.But because I pre-formatted the rows “before” pasting data in it (via this VBA code)… my row number /row count is not coming correct.

2. I want this row number so that I can paste it in the index worksheet. This index worksheet worksheet will tell me which row was pasted and when.
3. In continuation to point 2 above, when I asked about extracting part of the filename – I will be putting that in the index worksheet so that I can relate the newly pasted row (in Order_details worksheet) back to the original filename I have received. The file cannot have 2 or 3 or all combinations. As these values represents the depot short code. So one file can only come from one deport.

If you combine all the three points above.. I will be making an index like one below

Date Row Number Row Number Description User Imported the file
12/12/2017 Row 277 ORD-DL-LOND-003 Application.UserName
12/12/2017 Row 278 ORD-OL-003 (SWA 10.16) Application.UserName
12/12/2017 Row 279 ORD-OFF-002 Application.UserName


Also in the first column of the Order_Details worksheet – I need to put this name of the file as mentioned above i.e. ORD-DL-LOND-003 or ORD-OFF-002 etc.

Hope this will make the reqt clear.

Thanks.

1) The macro is only copying values, so if you setup the format you want in the consolidated file, that format should be preserved.
2) Yes, what do you want to do with it?
3) Doable, will the file name contain only DL, OL, or OFF (ie can never have 2 or all 3 of those values)?
Do you want to overwrite the depot name, with these values?

 

[Fluff]

How about

Sub OpenCopyTrans()

   Dim Fname As String
   Dim Wbk As Workbook
   Dim Sht As Worksheet
   Dim NxtRw As Long
   
   Set Sht = ActiveSheet
   NxtRw = Sht.Range("D" & Rows.Count).End(xlUp).Offset(1).row
   Fname = Application.GetOpenFilename("Excel files (*.xls*), *.xls*", , "select a File", , False)
   If Fname = "False" Then Exit Sub
   Set Wbk = Workbooks.Open(Fname)
   
   Sht.Range("A" & NxtRw).Resize(1, 9).Value = _
   Application.Transpose(Wbk.Sheets("Sheet1").Range("C2:C10").Value)
   
   If InStr(Fname, "DL") > 1 Then
      Sht.Range("A" & NxtRw).Value = "DL"
   ElseIf InStr(Fname, "OL") > 1 Then
      Sht.Range("A" & NxtRw).Value = "DL"
   ElseIf InStr(Fname, "OFF") > 1 Then
      Sht.Range("A" & NxtRw).Value = "DL"
   End If
   
   With Sheets("[COLOR=#ff0000]Index[/COLOR]").Range("A" & Rows.Count).End(xlUp).Offset(1)
      .Value = Date
      .Offset(, 1).Value = NxtRw - 1
      .Offset(, 2).Value = Fname
      .Offset(, 3).Value = Environ("Username")
   End With
      
   Wbk.Close False
   
   
End Sub

Change the Index sheet in red to suit.

 

[chetanojha]

Hi fluff,

Based on your code.. I modified the code a little with my limited knowledge of VBA in excel.

The latest code you have posted is not working for some reason. So i thought i would rather post the real code i am using so that you can understand what I am trying to do here. I know this is very primitive compare to what you have posted.

Private Sub CommandButton1_Click()
Dim Fname As String
Dim Wbk As Workbook
Dim Sht As Worksheet
Dim RowNumber As String
Dim NxtRw As Long



'Set Worksheet Consolidated to populate Data
Set Sht = ThisWorkbook.Worksheets("Consolidated")
Fname = Application.GetOpenFilename("Excel files (*.xls*), *.xls*", , "select a File", , False)
If Fname = "False" Then Exit Sub
Set Wbk = Workbooks.Open(Fname)

'Populate Column A with the name of the file (this should be the string extracted from Fname)
Sht.Range("A" & Sht.Rows.Count).End(xlUp).Offset(1).Resize(1, 1).Value = _
Fname


'Populate Column G7 to G16
Sht.Range("D" & Sht.Rows.Count).End(xlUp).Offset(1).Resize(1, 10).Value = _
Application.Transpose(Wbk.Sheets("Order_Details").Range("G7:G16").Value)


'Populate Column G17 to G28
Sht.Range("O" & Sht.Rows.Count - 1).End(xlUp).Offset(0).Resize(1, 10).Value = _
Application.Transpose(Wbk.Sheets("Order_Details").Range("G17:G28").Value)



'Populate Column Y
Sht.Range("Y" & Sht.Rows.Count - 1).End(xlUp).Offset(0).Resize(1, 1).Value = _
"To Be Loaded"


'Populate Column Z
Sht.Range("Z" & Sht.Rows.Count - 1).End(xlUp).Offset(0).Resize(1, 1).Value = _
"SI"

'Populate Username and description with date in column AA
Sht.Range("AA" & Sht.Rows.Count - 1).End(xlUp).Offset(0).Resize(1, 1).Value = _
Environ("Username") & ":" & Date & ":Auto Loaded using Button"

' This is to find the RowNumber to be populated in the Index worksheet
RowNumber = Sht.Cells(65535, 4).End(xlUp).Row


MsgBox RowNumber


Wbk.Close False

'NOW POPULATE CHANGE CONTROL WORKSHEET
Set Sht = ThisWorkbook.Worksheets("Index")

'Populate Date of the file receipt
Sht.Range("A" & Sht.Rows.Count).End(xlUp).Offset(1).Resize(1, 1).Value = _
Date

'Populate Row
Sht.Range("B" & Sht.Rows.Count).End(xlUp).Offset(1).Resize(1, 1).Value = _
"Row " & RowNumber

'Populate Row Number and Description
Sht.Range("C" & Sht.Rows.Count).End(xlUp).Offset(1).Resize(1, 1).Value = _
RowNumber & " : New AutoPopulated"

'Populate User Name
Sht.Range("D" & Sht.Rows.Count).End(xlUp).Offset(1).Resize(1, 1).Value = _
Application.UserName

'Populate Comment
Sht.Range("E" & Sht.Rows.Count).End(xlUp).Offset(1).Resize(1, 1).Value = _
"SI: " & "TBC"



End Sub

Thanks.