VBA Userform Setup

[CodesiriuS]

I have the code that the user can pulls up the C: directory, select the file and once selected the file path appears in a text box. The issue is I'm having a hard time getting the code to format the file that is selected in the texbox rather than the active worksheet. Would you happen to know if this is a simple fix like maybe instead of activeworksheet its selectedworksheet... Any help or even book references would be great I don't mind researching I'm just kind of at a dead-end at the moment

Private Sub CommandButton1_Click()
Dim SelectedFile As String

With Application.FileDialog(msoFileDialogFilePicker)
.Title = "Select required files"
.AllowMultiSelect = False
.InitialFileName = "Computer:"
.Filters.Clear
.Filters.Add "Excel Documents", "*.Xlsx", 1
.Filters.Add "Excel Documents", "*.Xls", 1
If .Show Then
SelectedFile = .SelectedItems(1)
Me.TextBox1 = SelectedFile
Else
MsgBox "User cancelled." & vbLf & vbLf & _
"Processing terminated."
Exit Sub
End If
End With
End Sub


Private Sub CommandButton2_Click()
Application.Run "Cleanup"
End Sub
--------------------------------------------------
Cleanup(module1)
Sub Cleanup()
Dim ws1 As Worksheet, ws2 As Worksheet

'setup
Application.ScreenUpdating = False
Set ws1 = ActiveSheet

'delete existing
On Error Resume Next
Application.DisplayAlerts = False
Worksheets("NEW").Delete
Application.DisplayAlerts = True
On Error GoTo 0


'add new
Worksheets.Add.Name = "FDM FORMATTED"
Set ws2 = Worksheets("FDM FORMATTED")

'copy data from 1 to 2
ws1.UsedRange.Copy
ws2.Cells(1, 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

'delete rows with col A blank
On Error Resume Next
ws2.Columns(1).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
On Error GoTo 0

'delete rows with col C blank
On Error Resume Next
ws2.Columns(3).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
On Error GoTo 0

'delete rows with col D text
On Error Resume Next
ws2.Columns(4).SpecialCells(xlCellTypeConstants, xlTextValues).EntireRow.Delete
On Error GoTo 0

'delete rows with col F numbers
On Error Resume Next
ws2.Columns(6).SpecialCells(xlCellTypeConstants, xlNumbers).EntireRow.Delete
On Error GoTo 0

'cleanup
Application.ScreenUpdating = True
ws2.Select
ws2.Cells(1, 1).CurrentRegion.EntireColumn.AutoFit


End Sub

 

[Craggs82]

Hey CodesiriuS,

I'm a little confused, are you trying to move the text from the userform textbox onto the worksheet?

if so you'll have to reference the userformname.textbox1 value rather than the activesheet. Userforms aren't worksheets and vice-versa.

'copy data from 1 to 2
    'ws1.UsedRange.Copy
    'ws2.Cells(1, 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
'can be replaced with

ws2.cells(1,1) = UserformName.Textbox1.value 'replace "userformname" with the correct name :)

hopefully i don't have the wrong end of the stick!

 

[CalcSux78]

There is no reference to the workbook selected in TextBox1 within the CommandButton2_Click sub. As written, it will add a new sheet to "ThisWorkbook" and move data to the new sheet (within the same workbook).

Before your "add new" comment, declare a workbook reference and use to identify which book to pull data from and where to send it.

Dim wThis as Workbook
Dim wThat as Workbook

Set wThis = ThisWorkbook
set wThat = Workbooks(TextBox1.Value)

 

[CodesiriuS]

Hey Craggs82 -

Im actually trying to build a utility so I can format a file that is selected the problem is it works great if I paste what I need formatted in the active workbook but not the selected file in the textbox - Do you I need to have code that opens the workbook first to be able to format it or can I apply formatting in VBA based on a file path? my code so far -

Private Sub CommandButton1_Click()
Dim SelectedFile As String

With Application.FileDialog(msoFileDialogFilePicker)
.Title = "Select required files"
.AllowMultiSelect = False
.InitialFileName = "Computer:"
.Filters.Clear
.Filters.Add "Excel Documents", "*.Xlsx", 1
.Filters.Add "Excel Documents", "*.Xls", 1
If .Show Then
SelectedFile = .SelectedItems(1)
Me.TextBox1 = SelectedFile
Else
MsgBox "User cancelled." & vbLf & vbLf & _
"Processing terminated."
Exit Sub
End If
End With
End Sub


Private Sub CommandButton2_Click()


Dim ws As Worksheet

Application.ScreenUpdating = False
For Each ws In ActiveWorkbook.Worksheets
Call Cleanup(ws)
Next
Application.ScreenUpdating = True
End Sub
-----------------------
Sub Cleanup(ws1 As Worksheet)
Dim ws2 As Worksheet
Dim sWS2 As String

sWS2 = "FDM Formatted"

'delete existing
On Error Resume Next
Application.DisplayAlerts = False
Worksheets(sWS2).Delete
Application.DisplayAlerts = True
On Error GoTo 0


'add new
Worksheets.Add.Name = sWS2
Set ws2 = Worksheets(sWS2)

'copy data from 1 to 2
ws1.UsedRange.Copy
ws2.Cells(1, 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

On Error Resume Next
'delete rows with col A blank
ws2.Columns(1).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
'delete rows with col C blank
ws2.Columns(3).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
'delete rows with col D text
ws2.Columns(4).SpecialCells(xlCellTypeConstants, xlTextValues).EntireRow.Delete
'delete rows with col F numbers
On Error Resume Next
ws2.Columns(6).SpecialCells(xlCellTypeConstants, xlNumbers).EntireRow.Delete
On Error GoTo 0

'cleanup
ws2.Cells(1, 1).CurrentRegion.EntireColumn.AutoFit

End Sub

 

[CodesiriuS]

Thanks CAlcSux78 -

I tried this: but I get an error saying textbox1 .value "Script is out of range" -

Private Sub CommandButton2_Click()


Dim ws As Worksheet
Dim wThis As Workbook
Dim wThat As Workbook


Set wThis = ThisWorkbook
Set wThat = Workbooks(TextBox1.Value)

Application.ScreenUpdating = False
For Each ws In ActiveWorkbook.Worksheets
Call Cleanup(ws)
Next
Application.ScreenUpdating = True
End Sub
--------------------
Private Sub CommandButton1_Click()
Dim SelectedFile As String

With Application.FileDialog(msoFileDialogFilePicker)
.Title = "Select required files"
.AllowMultiSelect = False
.InitialFileName = "Computer:"
.Filters.Clear
.Filters.Add "Excel Documents", "*.Xlsx", 1
.Filters.Add "Excel Documents", "*.Xls", 1
If .Show Then
SelectedFile = .SelectedItems(1)
Me.TextBox1 = SelectedFile
Else
MsgBox "User cancelled." & vbLf & vbLf & _
"Processing terminated."
Exit Sub
End If
End With
End Sub


Private Sub CommandButton2_Click()


Dim ws As Worksheet
Dim wThis As Workbook
Dim wThat As Workbook


Set wThis = ThisWorkbook
Set wThat = Workbooks(TextBox1.Value)

Application.ScreenUpdating = False
For Each ws In ActiveWorkbook.Worksheets
Call Cleanup(ws)
Next
Application.ScreenUpdating = True
End Sub




Private Sub TextBox1_Change()


End Sub

 

[Norie]

What you should do is use Application.GetOpenFilename to allow the user to pick the file to open then have code to open that file and set a reference to it.

The reference you set then can be used in the rest of the code to refer to the file the user selected and carry out any actions, eg formatting, on it.

Something like this should get you started.

UserForm module

Private Sub CommandButton1_Click()
Dim wbOpen As Workbook
Dim SelectedFile As String

ChDir "C:\Test"    ' change this to open the dialog in a specific directory if required


    SelectedFile = Application.GetOpenFilename("Excel Workbooks (*.xls*),*.xls*", , "Please select workbook to format")

    If SelectedFile <> "False" Then
        Set wbOpen = Workbooks.Open(SelectedFile)
        Cleanup wbOpen
    End If

End Sub

Module1

Option Explicit

Sub Cleanup(wb As Workbook)
Dim ws1 As Worksheet, ws2 As Worksheet

    'setup
    Application.ScreenUpdating = False

    With wb
        Set ws1 = .ActiveSheet

        'delete existing
        Application.DisplayAlerts = False
        .Worksheets("NEW").Delete
        Application.DisplayAlerts = True
        On Error GoTo 0

        'add new
        Set ws2 = Worksheets.Add
        ws2.Name = "FDM FORMATTED"
    End With

    'copy data from 1 to 2
    ws1.UsedRange.Copy
    ws2.Cells(1, 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

    'delete rows with col A blank
    On Error Resume Next
    ws2.Columns(1).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
    On Error GoTo 0

    'delete rows with col C blank
    On Error Resume Next
    ws2.Columns(3).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
    On Error GoTo 0

    'delete rows with col D text
    On Error Resume Next
    ws2.Columns(4).SpecialCells(xlCellTypeConstants, xlTextValues).EntireRow.Delete
    On Error GoTo 0

    'delete rows with col F numbers
    On Error Resume Next
    ws2.Columns(6).SpecialCells(xlCellTypeConstants, xlNumbers).EntireRow.Delete
    On Error GoTo 0

    'cleanup
    Application.ScreenUpdating = True

    ws2.Cells(1, 1).CurrentRegion.EntireColumn.AutoFit

End Sub

 

[CodesiriuS]

Thanks norie - Im getting an error here at this line .Worksheets("NEW").Delete its saying im out of range

 

[Norie]

Oops, I removed the On Error Resume Next by accident.

Option Explicit

Sub Cleanup(wb As Workbook)
Dim ws1 As Worksheet, ws2 As Worksheet

    'setup
    Application.ScreenUpdating = False

    With wb
        Set ws1 = .ActiveSheet

        On Error Resume Next
        'delete existing
        Application.DisplayAlerts = False
        .Worksheets("NEW").Delete
        Application.DisplayAlerts = True
        On Error GoTo 0

        'add new
        Set ws2 = Worksheets.Add
        ws2.Name = "FDM FORMATTED"
    End With

    'copy data from 1 to 2
    ws1.UsedRange.Copy
    ws2.Cells(1, 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

    'delete rows with col A blank
    On Error Resume Next
    ws2.Columns(1).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
    On Error GoTo 0

    'delete rows with col C blank
    On Error Resume Next
    ws2.Columns(3).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
    On Error GoTo 0

    'delete rows with col D text
    On Error Resume Next
    ws2.Columns(4).SpecialCells(xlCellTypeConstants, xlTextValues).EntireRow.Delete
    On Error GoTo 0

    'delete rows with col F numbers
    On Error Resume Next
    ws2.Columns(6).SpecialCells(xlCellTypeConstants, xlNumbers).EntireRow.Delete
    On Error GoTo 0

    'cleanup
    Application.ScreenUpdating = True

    ws2.Cells(1, 1).CurrentRegion.EntireColumn.AutoFit

End Sub

 

[CodesiriuS]

Norie you're awesome thanks for this!!!!
Dumb question but do you know how to unload the form after it runs?

 

[Norie]

All you need for that is this.

Unload Me