problem in creating text file by running macro in excel

sami9

Board Regular
Joined
Feb 12, 2014
Messages
50
I have a excel file Named Test and sheet Named Mysheet. My final output is in column M5 to M100 depending whether data is upto M70 or M15 etc. I need test file upto the row where data is available. I just tried with data in M5 and M6, it created text file with two rows that is o.k. But when I hide the column M whether with Hide option in format cells menu or with custom menu i.e three semicolumn (;;;) and then if I creat text file then text file have only one row that is with column M5 and M6 is not there. It means when hidden, text file is taking data from first row only i.e M5. I am attaching the code. Please check where correction is required because I want text file should have data from all the continuous rows from M5 onwards and secondly column M5 should be hidden also.

Code:

Private Sub Was()
Dim rng As Range, rng2 As Range
Dim sSaveAsFilePath As String
Dim ws1 As Worksheet
Dim wb As Workbook
Const mypassword As String = "*****"

Application.ScreenUpdating = False
Set wb = Workbooks.Add(1)
Set ws1 = wb.Worksheets(1)
ws1.Name = "TEST"
Set sh = ThisWorkbook.Worksheets("MySheet")
With sh
.Unprotect Password:=mypassword
.Columns("M").Hidden = False
End With

sSaveAsFilePath = ThisWorkbook.Path

On Error GoTo exitprog
LastRow = sh.Range("M" & sh.Rows.Count).End(xlUp).Row
Set rng = sh.Range("M5:M" & LastRow)

rng.AutoFilter _
Field:=1, _
Criteria1:="<>", _
VisibleDropDown:=False

Set rng = sh.AutoFilter.Range

'unrem to exclude header row
'Set rng = rng.Offset(1, 0).Resize(rng.Rows.Count - 1)

Set rng2 = rng.SpecialCells(xlCellTypeVisible)

If Not rng2 Is Nothing Then
rng2.Copy
ws1.Range("A1").PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
wb.SaveAs sSaveAsFilePath & "" & ws1.Name & " " & Format$(Now, "dd-mm-yyyy hh.mm") & ".txt", xlTextWindows
wb.Close False
End If

exitprog:
rng.AutoFilter

With sh
.Columns("M").Hidden = True
.Protect Password:=mypassword
End With
Application.ScreenUpdating = True
If Err > 0 Then
MsgBox (Error(Err)), 48, "Error"
If Not wb Is Nothing Then wb.Close False
Err.Clear
End If
End Sub
 

Excel Facts

Remove leading & trailing spaces
Save as CSV to remove all leading and trailing spaces. It is faster than using TRIM().
I do not know but now it is working as I needed. Thanks to all. Sometime somethings don't go the way you wanted but then suddenly everything is o.k and you do not know the reason.
 
Upvote 0

Forum statistics

Threads
1,214,947
Messages
6,122,411
Members
449,081
Latest member
JAMES KECULAH

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top