VBA Simple Code Help (Formatting FDM)

[CodesiriuS]

Is there a way to strip formatting, pictures etc. from an existing document into a new worksheet in the same workbook. The catch is i'm trying to work around subtotals and blank lines as well so aside from just wanting the raw data cleaned up I'm only trying to bring in rows from column A that are in this format ####-### is this possible with VBA?
What I have so far is this


Sub AddNameNewSheet2()Dim Newname As String
Newname = "FDM Formatted"
Sheets.Add Type:=xlWorksheet
ActiveSheet.Name = Newname
End Sub

[Logit]

I'm using Excel 2007 so hopefully there won't be much difference in the location of these menu selections.


1 - Highlight Col A


2 - Go to menu tab DATA / Filter (click filter)


3 - Click the small filter icon at the top of Col A / right side


4 - Select Text Filters / Custom Filter / Equals


5 - In the right side text box type ????-??? and click OK


Only those entries with a format of ####-### should be seen.


Highlight all of the row/s information you need, copy / paste

[CodesiriuS]

Thanks Logit, that's a great idea. This will work in the meantime while I play around with the code

[Logit]

Great. Sometimes it's best to not re-invent the wheel but I understand the desire for automation.

Merry Christmas !

[Paul_Hossler]

Since the data seems to be regular ...




Option Explicit

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 = "New"
Set ws2 = Worksheets("New")

'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

[CodesiriuS]

OMG thats brilliant thank you!!!!!!!!

[CodesiriuS]

I hate to bug and feel free to tell me to bug off but I was playing with your code and put it in a userform: 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 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

[Paul_Hossler]

Not tested

Command button 2 loops through all worksheets and pass each worksheet as a parameter to the 'general purpose' (i.e. not WS specific) Cleanup sub

Cleanup now creates a new WS named the same as the input except with '-New' added

BTW I did not see where SelectedFile is actually opened




Option Explicit

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 = ws1.Name & "-New"

'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 paul I think I'm following what you did - however when I run it i'm getting the following error (Variable not defined error) it doesn;'t like the sWS2 = ws1.Name & "-New" - ws1 portion.

I tried this - Dim ws1 As Worksheet, ws2 As Worksheet but I get the "Object variable or With block variable not set" error box

[CodesiriuS]

Thanks paul I think I got it!!!! I just need to add some code to get the selected file to open and then i'm good - Many thanks for your help!!!!