Avinash Crap Pending sorting out

[fixer]

Moderator Notice:
In the course of sorting the mess out typically said OP posts, I may need to temporarily to store stuff here. Most stuff here does not really fit anywhere, but I might need bits of it in thee future when straitening out the mess he makes..

---

---

Sub STEP10()

Dim oWB As Workbook
Dim oSheet As Worksheet
Dim FSO As Object, MyFile As Object
Dim FileName As String
Dim Arr As Variant, vRow As Variant
Dim NextRow As Long, lngRow As Long, lngCol As Long
    Set oWB = Workbooks.Open(ThisWorkbook.Path & "\Error.xlsx")
    Set oSheet = oWB.Sheets(1)
    NextRow = oSheet.UsedRange.Rows(oSheet.UsedRange.Rows.Count).Row + 1
    FileName = oWB.Path & "\BasketOrder..csv"
    Set FSO = CreateObject("Scripting.FileSystemObject")
    Set MyFile = FSO.OpenTextFile(FileName, 1)
    Arr = Split(MyFile.ReadAll, vbNewLine)
    For lngRow = 0 To UBound(Arr)
        vRow = Split(Arr(lngRow), ",")
        For lngCol = 0 To UBound(vRow)
            oSheet.Cells(NextRow, lngCol + 1) = vRow(lngCol)
        Next lngCol
        NextRow = NextRow + 1
    Next lngRow
    oWB.Save
    Set FSO = Nothing
    Set oSheet = Nothing
    Set MyFile = Nothing
    oWB.Close SaveChanges:=True
End Sub

Sub STEP3()
    Dim wb1 As Workbook
    Dim wb2 As Workbook
    Dim wb3 As Workbook
    Dim ws1 As Worksheet
    Dim ws2 As Worksheet
    Dim ws3 As Worksheet
    Dim strPath As String
    Dim R As Long
    Dim m As Long
    Dim rng As Range
    Dim n As Long
    Application.ScreenUpdating = False
    Set wb1 = Workbooks.Open(ThisWorkbook.Path & "\1.xls")
    Set ws1 = wb1.Worksheets(1)
    m = ws1.Range("H" & ws1.Rows.Count).End(xlUp).Row
    strPath = ThisWorkbook.Path & "\"
    Set wb2 = Workbooks.Open(strPath & "OrderFormat.xlsx")
    Set ws2 = wb2.Worksheets(1)
    ws2.Range("A1:A4").TextToColumns DataType:=xlDelimited, Tab:=True, _
    SemiColon:=False, Comma:=False, Space:=False, Other:=False, _
    ConsecutiveDelimiter:=False
    Set wb3 = Workbooks.Open(strPath & "BasketOrder..csv")
    Set ws3 = wb3.Worksheets(1)
    Set rng = ws3.Cells.Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious)
    If rng Is Nothing Then
        n = 1
    Else
        n = rng.Row + 1
    End If
    For R = 2 To m
        If ws1.Range("H" & R).Value > ws1.Range("D" & R).Value Then
            ws2.Range("A2").EntireRow.Copy Destination:=ws3.Range("A" & n)
            n = n + 1
        ElseIf ws1.Range("H" & R).Value < ws1.Range("D" & R).Value Then
            ws2.Range("A4").EntireRow.Copy Destination:=ws3.Range("A" & n)
            n = n + 1
        End If
    Next R
    Application.DisplayAlerts = False
    wb1.Close SaveChanges:=False
    wb2.Close SaveChanges:=False
    wb3.SaveAs Filename:=strPath & "BasketOrder..csv", FileFormat:=xlCSV
    wb3.Close SaveChanges:=False
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
End Sub

I have these code it works perfect
But i changed BasketOrder..csv to BasketOrder.xlsx
so in this macro changes are required for the same