1. Computer problem? Tech Support Guy is completely free -- paid for by advertisers and donations. Click here to join today! If you're new to Tech Support Guy, we highly recommend that you visit our Guide for New Members.

VBA - Excel 2007 - Macro

Discussion in 'Business Applications' started by SPeteS, Dec 21, 2010.

Thread Status:
Not open for further replies.
Advertisement
  1. SPeteS

    SPeteS Thread Starter

    Joined:
    Dec 6, 2010
    Messages:
    83
    ;)
    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
     
  2. SPeteS

    SPeteS Thread Starter

    Joined:
    Dec 6, 2010
    Messages:
    83
    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
     

    Attached Files:

  3. Ziggy1

    Ziggy1

    Joined:
    Jun 17, 2002
    Messages:
    2,532
    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?
     
  4. SPeteS

    SPeteS Thread Starter

    Joined:
    Dec 6, 2010
    Messages:
    83
    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.
     

    Attached Files:

  5. SPeteS

    SPeteS Thread Starter

    Joined:
    Dec 6, 2010
    Messages:
    83
    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?
     

    Attached Files:

  6. Ziggy1

    Ziggy1

    Joined:
    Jun 17, 2002
    Messages:
    2,532

    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"

    Code:
    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

    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.
     
  7. Keebellah

    Keebellah Trusted Advisor

    Joined:
    Mar 27, 2008
    Messages:
    5,946
    I downloaded the files but it'll have to wait unitl after the 3d of January.

    Merry X'Mas and a Happy 2011
     
  8. Ziggy1

    Ziggy1

    Joined:
    Jun 17, 2002
    Messages:
    2,532
    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.


    Code:
    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
     

    Attached Files:

  9. SPeteS

    SPeteS Thread Starter

    Joined:
    Dec 6, 2010
    Messages:
    83
    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
     

    Attached Files:

  10. Ziggy1

    Ziggy1

    Joined:
    Jun 17, 2002
    Messages:
    2,532
    you haven't commented on what I posted, did you try it?
     
  11. SPeteS

    SPeteS Thread Starter

    Joined:
    Dec 6, 2010
    Messages:
    83
    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
     

    Attached Files:

  12. SPeteS

    SPeteS Thread Starter

    Joined:
    Dec 6, 2010
    Messages:
    83
    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
     
  13. Keebellah

    Keebellah Trusted Advisor

    Joined:
    Mar 27, 2008
    Messages:
    5,946
    Well you sort them separatley so that's what it does.
    I'll edit the code for you later this evening
     
  14. Keebellah

    Keebellah Trusted Advisor

    Joined:
    Mar 27, 2008
    Messages:
    5,946
    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

    Code:
    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


    Code:
    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
    
     
  15. SPeteS

    SPeteS Thread Starter

    Joined:
    Dec 6, 2010
    Messages:
    83
    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?
     
  16. Sponsor

As Seen On
As Seen On...

Welcome to Tech Support Guy!

Are you looking for the solution to your computer problem? Join our site today to ask your question. This site is completely free -- paid for by advertisers and donations.

If you're not already familiar with forums, watch our Welcome Guide to get started.

Join over 733,556 other people just like you!

Loading...
Thread Status:
Not open for further replies.

Short URL to this thread: https://techguy.org/969802