Code: Select all
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 SubCode: Select all
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 SubI have these code it works perfect
But i changed BasketOrder..csv to BasketOrder.xlsx
so in this macro changes are required for the same
So plz help me for the same
https://www.excelfox.com/forum/showthre ... Correction
