I have the following vba code, it is not working. though it converts the excel to text but not the way i need.
Essentially i am trying
1. First Copy the selected sheet from the workbook and create a new sheet with the selected as workbook
2. copy and value paste all the cells starting from cell A1 to AG3000
3. remove first 7 rows
4. column A refers to category and i want to keep on IN HOUSE rows
5. keep columns C,D,G and O
6. rename the column C as modelname
7. save it as text file in desktop
please let where i am going wrong
HTML Code:
Sub ExportDataToTextFile()
Dim newWB As Workbook
Dim wsCopy As Worksheet
Dim LastRow As Long, LastCol As Long
Dim i As Long
Dim keepColumns As Variant
' Columns to keep
keepColumns = Array("C", "D", "G", "O")
' Create a new workbook and copy the worksheet to it
ThisWorkbook.Sheets("SomeSheetOne").Copy
Set newWB = ActiveWorkbook
Set wsCopy = newWB.Sheets(1)
' Paste values to remove formulas
With wsCopy
.UsedRange.Value = .UsedRange.Value
LastRow = 3010 ' Assuming Last Row is fixed at 3010
LastCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
End With
' Remove rows where Column A is not "IN HOUSE"
For i = LastRow To 9 Step -1
If wsCopy.Cells(i, 1).Value <> "IN HOUSE" Then
wsCopy.Rows(i).Delete
End If
Next i
' Delete columns not in keepColumns array
For i = LastCol To 1 Step -1
If Not IsError(Application.Match(wsCopy.Cells(1, i).Value, keepColumns, 0)) Then
' Column header found in keepColumns array, do nothing
Else
wsCopy.Columns(i).Delete
End If
Next i
' Remove duplicates based on all columns
With wsCopy
.Range("A1").CurrentRegion.RemoveDuplicates Columns:=Array(1, 2, 3, 4), Header:=xlYes
LastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
End With
' Change header of column A to "Model Name"
wsCopy.Cells(1, 1).Value = "Model Name"
' Save the workbook as a text file on the desktop
newWB.SaveAs Filename:="C:\Users\prabir\Desktop\TESTONE.txt", FileFormat:=xlText, CreateBackup:=False
' Close the workbook without saving changes
newWB.Close SaveChanges:=False
End Sub