VBA - Excel 2007 - Macro

[SPeteS]

I hope you guys can help me out again with this. It seems similar to the the issue that I posted last time. But I think it is a little bit more complicated.
I receive two notepad - files (for example importfile 1 and importfile 2) via mail, I copy paste the data in an excel sheet.
Each line in the notepad - files is an order. The format of the file is :
- Character 1 to 2 (included) = Plant
- Character 3 to 5 (included) = Route
- Character 6 to 8 (included) = Suffix
- Character 9 to 18 (included) = Delivery Date
- Character 19 to 27 (included) = DunsNo
- Character 28 to 35 (included) = ContainerNo
- Character 36 to 40 (included) = Quantity
- Character 41 to 49 (included) = Total Weight
- Character 50 to 61 (included) = Volume
- Character 62 to 69 (included) = Planned Date
A csv-file ( has to be created for each line with the same route, suffix, delivery date and DunsNo.
The name of the csv-files to be created has the following format : Route_Suffix_Delivery Date
(for example DG2_3HB_22-12-2010
The output file consists of following format :
Cell A1 is always T , Cell A2 = the data in collumn D that matches the routeNo in collumn A of a excel-file (for example Trailer_Types1)
Then each row begins with P in collumn A for each line with the same route, delivery and DunsNo
Collumn B = Plant of notepad - file
Collumn C = Route of notepad - file
Collumn D = Suffix of notepad - file
Collumn E = Delivery Date of notepad -file
Collumn F = DunsNo of notepad - file
Collumn G = Container of notepad - file
Collumn H = Quantity of notepad - file
Collumn I = Total Weight of notepad -file devided by Quantity of notepad - file
The data of the next collumns are collected from a file (for example Item_Basedata) --> The first 3 collumns of this file contain following data : Collumn A = Container ; Collumn B = Route ; Collumn C = DunsNo. If these 3 collumns match with the container / route / DunsNo data in a row of the notepad file, the data in collumn D,E,F,G,H,I,J,K,L,M,N,O,P,Q,R,S,T,U,V,W can be copied in the output csv-file.
i.e.
Collumn J to collumn AC
The example files in attachment are:
importfile1 and importfile2
Item_BaseData
Trailer_Types1
DG2_3HB_22-12-2010

 

[SPeteS]

The attachments : ...
importfile1 and importfile2 are both textfile (original with extension *.dat)
Item_Basedata
Trailer_Types1
DG2_3HB_22-12-2010 has to be csv-file

 

[Ziggy1]

first off, you can do a lot of this yourself start in Excel activate the macro recorder.... the proceed to open one of your text files, change the files of type to .txt and use the Text import wizard with the "Fixed width" option, set all the columns, then proceed to arrange and SAVE as a CSV... and stop the recorder.

Do that part and post the book with Macro, if you need further modifications to incorporate variables for anything. Unless I am missing something that is all I see you needing?

 

[SPeteS]

Hello,
Is it possible for me that I can get a prompt to specifie in which directory and which files I would like to retrieve?
I could not send you this file in csv-format. Therefore I uploaded it as workbook.
Thanks for your help.

 

[SPeteS]

I think in the previous file the macro was not included when I saved it.
How can I save the files in csv ; - format instead of , - format?

 

[Ziggy1]

Hello,
Is it possible for me that I can get a prompt to specifie in which directory and which files I would like to retrieve?
.

This will prompt you to pick a filename....

** Note that if you already have the procedure you only need to copy what I have between the "Sub"

Public Sub OpenFile()

[COLOR="Red"]Dim File2Open As Variant

     File2Open = Application.GetOpenFilename("Excel Files (*.xl*)," & _
     "*.xl*", 1, "Select Excel File", "Open", False)

MsgBox File2Open[/COLOR]

End Sub

I think in the previous file the macro was not included when I saved it.
How can I save the files in csv ; - format instead of , - format?

Simply when saving change the file type ("Save as Type") to CSV... again the recorder can do all this for you.

** I can't download attachments from this location so just post Code examples if you are stuck, or I will check tonight.

 

[Keebellah]

I downloaded the files but it'll have to wait unitl after the 3d of January.

Merry X'Mas and a Happy 2011

 

[Ziggy1]

this is what I was talking about.... This will let you pick a file and it will split the data to the columns and then save as a CSV file, I added a Date/time stamp to the filename.

Sub Import1()
'
' Import1 Macro
' 22/12/2010 by Ziggy
'

Application.DisplayAlerts = False

Dim File2Open As Variant
Dim File2Save As String

     File2Open = Application.GetOpenFilename("Excel Files (*.txt)," & _
     "*.xl*", 1, "Select Excel File", "Open", False)

'MsgBox File2Open



'edit to set default open folder...
   ' ChDir "C:\Users\user\Documents\ForumHelp\Techguys\New folder"
    Workbooks.OpenText Filename:=File2Open, _
        Origin:=xlWindows, StartRow:=1, DataType:=xlFixedWidth, FieldInfo:= _
        Array(Array(0, 2), Array(2, 2), Array(5, 2), Array(8, 5), Array(18, 2), Array(27, 2), Array _
        (35, 1), Array(40, 1), Array(49, 1), Array(61, 2))
    ActiveWindow.WindowState = xlMaximized
    Cells.Select
    Cells.EntireColumn.AutoFit
   
   
   ' Filename with extension...
  File2Open = Mid(File2Open, InStrRev(File2Open, "\") + 1)
  
   ' remove extension....
  File2Open = Mid(File2Open, 1, InStrRev(File2Open, ".") - 1)
  
File2Save = File2Open & "_" & Format(Now(), "YYYYMMDD-HHmmss")
   
    ActiveWorkbook.SaveAs Filename:=File2Save & ".csv", FileFormat:=xlCSV, _
        CreateBackup:=False
        
       
        
   Application.DisplayAlerts = True
   
    ActiveWorkbook.Close (False)
        
End Sub

 

[SPeteS]

1 Column (X) is added in the Item Database file. So the data D, E, F, G, H, I, J, K, L, M, N, O, P, Q, R, S, T U, V, W, X may be added in the output file

 

[Ziggy1]

you haven't commented on what I posted, did you try it?

 

[SPeteS]

Hi Ziggy,

Sorry for my late reply.
Now the macro is creating a csv file every text file that in opened. This is not necessary.
It is also ok when the text file in loaded in e.g. sheet 2 (of the macro file) and another text file is copy/pasted below the first text-file in sheet 2.
Then that the data can be sorted on 1)column D, 2)column B and 3)column C. For each row with the same data in column D,B and C one new csv.file can be created where column A is filled with "P"(only column A to H of the old file has to be copied in the new file in column B to I)
According to the information in column C,F and G(of the new file) and the data of the file basedata, C of new file has to match with column B of basedata and F of new file has to match with C of basedata and G of new file has to match A basedata.
Then column D to X of basedata can be pasted in column J to AD of new file.
In row 1 column A is filled with "T" and column B is filled with the data of colum D of file Trailer_Types1 with a match between colum C of the new created file and column A of file Trailer_Types1.

In attachment I have sended what I've already got, but now I'm stuck with copy/pasting the 2nd file in the sheet.
Keebellah is also helping me with a solution.

Thnx

 

[SPeteS]

I've changed the macro a bit (My first macro with aid of you). Now this data has to be sorted on 1)column D and 2)columns B and 3) column C. I can't do this. It sorts the data on column D or Column B or column C.
CSV-files may be created of the data where Columns D, B and C is equal.
Then the ohter data has to be collected and pasted into new csv-files. But I don't know exactly how to do this. Can you help me out?

The Code I use so far is :

Option Explicit
Sub ImportMGOFiles()
'
Application.DisplayAlerts = False
Dim Result As VbMsgBoxResult
Dim Rang As String
Dim AantalRijen As Long
Dim Macro2Open As Variant
Dim MacroFile As Variant
Dim File2Open As Variant
Dim File2Save As String
Dim CountFile2Open As Integer
MacroFile = ActiveWorkbook.Name
CountFile2Open = 1
If CountFile2Open < 2 Then GoTo NewFile
Anotherfile:
'Message box if you still would like to open another MGO-File?
Result = MsgBox("Do you want to open another MGO-File?", vbYesNo Or vbInformation, "Open Another MGO-File???")
If Result = vbNo Then GoTo NoFile

NewFile:
'Case to indicate 1st, 2nd, 3rd, .... File
Select Case CountFile2Open
Case 1
Rang = "st"
Case 2
Rang = "nd"
Case 3
Rang = "rd"
Case 4
Rang = "th"
Case 5
Rang = "th"
Case 6
Rang = "th"
End Select

'Msgbox for 1st file to open
File2Open = Application.GetOpenFilename("MGO Files (*.dat)," & _
"*.xl*", 1, "Select " + CStr(CountFile2Open) + CStr(Rang) + " MGO-File", "Open", False)
If File2Open = False Then GoTo Anotherfile

'edit to set default open folder...
'ChDir "C:\Users\user\Documents\ForumHelp\Techguys\New folder"
Workbooks.OpenText Filename:=File2Open, _
Origin:=xlWindows, StartRow:=1, DataType:=xlFixedWidth, FieldInfo:= _
Array(Array(0, 2), Array(2, 2), Array(5, 2), Array(8, 5), Array(18, 2), Array(27, 2), Array _
(35, 1), Array(40, 1), Array(49, 1), Array(61, 2))
ActiveWindow.WindowState = xlMaximized
Cells.EntireColumn.AutoFit

'Count Number of used Cells and copy them
Range("A1").Select
Selection.End(xlDown).Select
AantalRijen = ActiveCell.Row
Range("A1", ActiveCell.Offset(AantalRijen, 8)).Select
Selection.Copy

'Paste this data in the macro file
Windows(MacroFile).Activate
Sheets("Sheet2").Select
If CountFile2Open < 2 Then
Range("A1").Select
Else
Range("A1").Select
Selection.End(xlDown).Select
End If
ActiveSheet.Paste

'Close MGO-file
Workbooks.OpenText Filename:=File2Open
ActiveWindow.Close

'Message Box if you want to open another MGO-file
Result = MsgBox("Do you want to open another MGO-File?", vbYesNo Or vbInformation, "Open Another MGO-File???")
If Result = vbYes Then
'Addd 1 with CountFile2Open
CountFile2Open = CountFile2Open + 1
GoTo NewFile
End If

NoFile:
'Open Macro file
Windows(MacroFile).Activate
'Sort Columns in macro file
Sheets("Sheet2").Select
Range("A1").Select
Cells.Select
Cells.EntireColumn.AutoFit
Range("D2").Select
ActiveWorkbook.Worksheets("Sheet2").Sort.SortFields.Add Key:=Range("D2"), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Sheet2").Sort
.SetRange Range("A1:J225")
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Range("B2").Select
ActiveWorkbook.Worksheets("Sheet2").Sort.SortFields.Add Key:=Range("B2"), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Sheet2").Sort
.SetRange Range("A1:J225")
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Range("C2").Select
ActiveWorkbook.Worksheets("Sheet2").Sort.SortFields.Add Key:=Range("C2"), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Sheet2").Sort
.SetRange Range("A1:J225")
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Range("A1").Select
Application.DisplayAlerts = True


End Sub

 

[Keebellah]

Well you sort them separatley so that's what it does.
I'll edit the code for you later this evening

 

[Keebellah]

Your Sortcode can be reduced to the follwoing:

In this case sort order is column D, then column C and last Column E

If you want to change these check Order1, Order2 and Order3 and Key1, Key2 and Key3 to change

Sub SortDCE()
    Sheets("Sheet2").Activate
    Range("A1:J225").Select
    Application.CutCopyMode = False
    Selection.Sort Key1:=Range("D2"), Order1:=xlAscending, Key2:=Range("C2") _
        , Order2:=xlAscending, Key3:=Range("E2"), Order3:=xlAscending, Header:= _
        xlYes, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal, DataOption2:=xlSortNormal, DataOption3:= _
        xlSortNormal
    Range("A1").Select
End Sub

Rerplace all the code below Nofile" with a line SubDCE to call this macro

Option Explicit
Sub ImportMGOFiles()
'
Application.DisplayAlerts = False
Dim Result As VbMsgBoxResult
Dim Rang As String
Dim AantalRijen As Long
Dim Macro2Open As Variant
Dim MacroFile As Variant
Dim File2Open As Variant
Dim File2Save As String
Dim CountFile2Open As Integer
MacroFile = ActiveWorkbook.Name
CountFile2Open = 1
If CountFile2Open < 2 Then GoTo NewFile
Anotherfile:
'Message box if you still would like to open another MGO-File?
Result = MsgBox("Do you want to open another MGO-File?", vbYesNo Or vbInformation, "Open Another MGO-File???")
If Result = vbNo Then GoTo NoFile

NewFile:
'Case to indicate 1st, 2nd, 3rd, .... File
Select Case CountFile2Open
Case 1
Rang = "st"
Case 2
Rang = "nd"
Case 3
Rang = "rd"
Case 4
Rang = "th"
Case 5
Rang = "th"
Case 6
Rang = "th"
End Select

'Msgbox for 1st file to open
File2Open = Application.GetOpenFilename("MGO Files (*.dat)," & _
"*.xl*", 1, "Select " + CStr(CountFile2Open) + CStr(Rang) + " MGO-File", "Open", False)
If File2Open = False Then GoTo Anotherfile

'edit to set default open folder...
'ChDir "C:\Users\user\Documents\ForumHelp\Techguys\New folder"
Workbooks.OpenText Filename:=File2Open, _
Origin:=xlWindows, StartRow:=1, DataType:=xlFixedWidth, FieldInfo:= _
Array(Array(0, 2), Array(2, 2), Array(5, 2), Array(8, 5), Array(18, 2), Array(27, 2), Array _
(35, 1), Array(40, 1), Array(49, 1), Array(61, 2))
ActiveWindow.WindowState = xlMaximized
Cells.EntireColumn.AutoFit

'Count Number of used Cells and copy them
Range("A1").Select
Selection.End(xlDown).Select
AantalRijen = ActiveCell.Row
Range("A1", ActiveCell.Offset(AantalRijen, 8)).Select
Selection.Copy

'Paste this data in the macro file
Windows(MacroFile).Activate
Sheets("Sheet2").Select
If CountFile2Open < 2 Then
Range("A1").Select
Else
Range("A1").Select
Selection.End(xlDown).Select
End If
ActiveSheet.Paste

'Close MGO-file
Workbooks.OpenText Filename:=File2Open
ActiveWindow.Close

'Message Box if you want to open another MGO-file
Result = MsgBox("Do you want to open another MGO-File?", vbYesNo Or vbInformation, "Open Another MGO-File???")
If Result = vbYes Then
'Addd 1 with CountFile2Open
CountFile2Open = CountFile2Open + 1
GoTo NewFile
End If

NoFile:
SubDCE

End Sub

 

[SPeteS]

Ok, thanks for your help Hans.
Can you help me also to get the data of Item_BaseData and Trailer_Types1 into the new to be created csv-file base on info of these 2 files and the sorted data in the macrofile?