Consulting

Results 1 to 6 of 6

Thread: Various items - exporting to various .txt files where duplicates

Threaded View

Previous Post Previous Post   Next Post Next Post
  1. #1

    Unhappy Various items - exporting to various .txt files where duplicates

    Hello all,

    I'm new to the wonderful world of VBA and have been getting stuck in for a week now. I am slightly out of my depth and would appreciate some help.

    I'm currently running Excel 2010 and trying to do the following:
    1.) Export a selection (fixed width columns J to CP and dynamic range of rows) to .txt files on a row by row basis (part solved, see below)
    2.) Move duplicates based on a value in column Q to different .txt files, so that there is only one unique row based on the column Q value in each .txt file.

    For part 1, I have found a great add-in that exports my data perfectly, however it requires manual selection of a range via a form, however, I need the tab to be very hidden, thus need this automated to not allow the end user access/view it. As such, I wish to remove the form altogether, and have the form take the values of the range I need to export from a defined range. My current module which defines my range to be exported succesfully:
    Sub ExportUKBL()
        'use End(xlToLeft) to determine last column with data in row (row number x)
        Dim lastColumn As Integer
        Worksheets("UKBL").Activate
        lastColumn = ActiveSheet.Cells(1, Columns.Count).End(xlToLeft).Column 'row number here
        
        'use End(xlUp) to determine Last Row with Data, in one column (column x)
        Dim lastRow As Long
        lastRow = ActiveSheet.Range("B" & Rows.Count).End(xlUp).Row 'column letter here
        
        Range(Cells(lastRow, 10), Cells(6, lastColumn)).Select
        
        'STEP TO BE INSERTED TO SAVE TO .TXT
        
        MsgBox "UK BL" & vbCrLf & "-----------------------------------" & vbCrLf & "Exported succesfully.", , "Data Export"
    End Sub
    Module 1 - For Userform
    Option Explicit
    
    Sub MakeFile()
        
        Dim rng As Range
        Dim NumR As Long
        Dim NumC As Long
        Dim CountR As Long
        Dim CountC As Long
        Dim Delim As String
        Dim Qual As String
        Dim Leading As Boolean
        Dim Trailing As Boolean
        Dim TheFile As String
        Dim fso As Object
        Dim ts As Object
        Dim LineStr As String
        
        UserForm1.Show 'TO REMOVE
        
        ' get variable setting from UserForm
        With UserForm1 ' TO REMOVE WITH
            Set rng = Range(.reRange)
            NumR = rng.Rows.Count
            NumC = rng.Columns.Count
            Delim = ","
            Qual = ""
            Leading = False
            Trailing = False
            TheFile = .tbCreateFile 'TRY TO SET A FILENAME UP HERE SO IT DOESN'T REQUIRE FORM?
        End With
        Unload UserForm1
        
        ' create the text file
        Set fso = CreateObject("Scripting.FileSystemObject")
        Set ts = fso.CreateTextFile(TheFile, True)
        
        ' loop through range to build text file records
        For CountR = 1 To NumR
            LineStr = IIf(Leading, Delim, "")
            For CountC = 1 To NumC
                If Not IsNumeric(rng.Cells(CountR, CountC)) And Not IsDate(rng.Cells(CountR, CountC)) Then
                    LineStr = LineStr & Qual & rng.Cells(CountR, CountC) & Qual
                Else
                    LineStr = LineStr & rng.Cells(CountR, CountC)
                End If
                LineStr = LineStr & IIf(CountC < NumC, Delim, "")
            Next
            LineStr = LineStr & IIf(Trailing, Delim, "")
            ts.WriteLine LineStr
        Next
        
        ' release memory from object variables
        ts.Close
        Set ts = Nothing
        Set fso = Nothing
           
        MsgBox "UKBL" & vbCrLf & "-----------------------------------------------------------------" & vbCrLf & "Exported succesfully " & TheFile, , "Data Export"
        
    End Sub
    My UserForm
    Option Explicit
    Private Sub cbWorkbook_Change()
        With Me
                Workbooks(.cbWorkbook.Value).Activate 'WHAT FORM SAYS WORKBOOK IS - WANT TO MAKE THAT CURRENT WORKBOOK ALWAYS
        End With
    End Sub
    Private Sub cbWorksheet_Change()
        With Me
                .reRange = Worksheets("UKBL").Select
                .reRange.Enabled = True 'WHAT FORM SAYS WORKSHEET IS
                .LabelRng.Enabled = True
            End With
    End Sub
    Private Sub cmdChange_Click()
    .tbCreateFile = Application.GetSaveAsFilename(.tbCreateFile, "Text Files (*.txt), *.txt", , _
              "Save Text File to...") 'WHAT FORM SAYS SAVEFILE IS
    End Sub
    Private Sub cmdGo_Click()
        Dim rng As Range
        With Me
            On Error Resume Next
            Set rng = Range(.reRange) 'WHAT FORM SAYS RANGE IT (WANT TO REPLACE)
            On Error GoTo 0
            ThisWorkbook.Worksheets("Sheet1").Range("cbWorkbook") = .cbWorkbook
            ThisWorkbook.Worksheets("Sheet1").Range("cbWorksheet") = .cbWorksheet
            ThisWorkbook.Worksheets("Sheet1").Range("reRange") = .reRange
            ThisWorkbook.Worksheets("Sheet1").Range("tbCreateFile") = .tbCreateFile
            ThisWorkbook.Save
            .Hide
        End With
    End Sub
    Private Sub tbCreateFile_Change()
    End Sub
    Private Sub UserForm_Initialize()
        Dim wb As Workbook
        With Me
            For Each wb In Workbooks
                .cbWorkbook.AddItem wb.Name
            Next
            .cbWorksheet.Enabled = False
            .LabelWs.Enabled = False
            .reRange.Enabled = False
            .LabelRng.Enabled = False
            On Error Resume Next
                .cbWorkbook = ThisWorkbook.Worksheets("Sheet1").Range("cbWorkbook")
                cbWorksheet_Change 'calls workbook change?
                .cbWorksheet = ThisWorkbook.Worksheets("Sheet1").Range("cbWorksheet")
                .reRange = ThisWorkbook.Worksheets("Sheet1").Range("reRange")
            On Error GoTo 0
            .tbCreateFile = ThisWorkbook.Worksheets("Sheet1").Range("tbCreateFile")
            End With
    End Sub
    I attach a copy of my spreadsheet layout for your reference.

    I would be grateful if anyone can help me out with the above. I have inched closer to reaching a solution on part 1, but have no clue as to the best way to approach part 2. I hope I have been sufficiently clear above.

    Thanks all in anticipation,

    Oscar
    Attached Files Attached Files

Tags for this Thread

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •