superostia
07-20-2014, 03:31 PM
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
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