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..

I have this Macro & i am modifying the same as per my needs


Sub STEP6()
Dim Wbm As Workbook: Set Wbm = ThisWorkbook
Dim Wb1 As Workbook, Wb2 As Workbook
Dim strWb1 As String: Let strWb1 = "1.xls"
Dim strWb2 As String: Let strWb2 = "Error.xlsx"

Dim Ws1 As Worksheet, Ws2 As Worksheet
Dim Lr1 As Long, Lr2 As Long: Let Lr1 = 5000: Lr2 = 5000

Workbooks.Open FileName:=ThisWorkbook.Path & "\" & strWb2
Set Wb2 = ActiveWorkbook '
Set Ws2 = Wb2.Worksheets.Item(1)
Workbooks.Open FileName:=ThisWorkbook.Path & "\" & strWb1
Set Wb1 = ActiveWorkbook
Set Ws1 = Wb1.Worksheets.Item(1)

Dim rngSrch As Range: Set rngSrch = Ws2.Range("C1:C" & Lr2 & "")
Dim rngDta As Range: Set rngDta = Ws1.Range("B2:B" & Lr1 & "")

Dim Cnt As Long
For Cnt = Lr2 To 1 Step -1
Dim MtchedCel As Variant
Set MtchedCel = rngSrch.Find(what:=rngDta.Item(Cnt), After:=rngSrch.Item(1), LookIn:=xlValues, LookAt:=xlWhole, SearchDirection:=xlNext, MatchCase:=True)
If Not MtchedCel Is Nothing Then
rngDta.Rows(Cnt).EntireRow.Delete Shift:=xlUp
Else
End If

Next Cnt
Wb1.Close SaveChanges:=True
Wb2.Close SaveChanges:=True
End Sub




changed Macro

Sub STEP6()
Dim Wbm As Workbook: Set Wbm = ThisWorkbook
Dim Wb1 As Workbook, Wb2 As Workbook
'Dim strWb1 As String: Let strWb1 = "1.xls"
'Dim strWb2 As String: Let strWb2 = "Error.xlsx"

Dim Ws1 As Worksheet, Ws2 As Worksheet
'Dim Lr1 As Long, Lr2 As Long: Let Lr1 = 5000: Lr2 = 5000(I have to remove the limitation of the macro plz see this line and plz let me know the changes for this also)

'Workbooks.Open FileName:=ThisWorkbook.Path & "\" & strWb2
Set Wb2 = Workbooks.Open("C:\Users\WolfieeeStyle\Desktop\Error.xlsx") 'ActiveWorkbook
Set Ws2 = Wb2.Worksheets.Item(1)
'Workbooks.Open FileName:=ThisWorkbook.Path & "\" & strWb1
Set Wb1 = Workbooks.Open("C:\Users\WolfieeeStyle\Desktop\1.xls") ' ActiveWorkbook
Set Ws1 = Wb1.Worksheets.Item(1)

Dim rngSrch As Range: Set rngSrch = Ws2.Range("C1:C" & Lr2 & "")
Dim rngDta As Range: Set rngDta = Ws1.Range("B2:B" & Lr1 & "")

Dim Cnt As Long
For Cnt = Lr2 To 1 Step -1
Dim MtchedCel As Variant
Set MtchedCel = rngSrch.Find(what:=rngDta.Item(Cnt), After:=rngSrch.Item(1), LookIn:=xlValues, LookAt:=xlWhole, SearchDirection:=xlNext, MatchCase:=True)
If Not MtchedCel Is Nothing Then
rngDta.Rows(Cnt).EntireRow.Delete Shift:=xlUp
Else
End If

Next Cnt
Wb1.Close SaveChanges:=True
Wb2.Close SaveChanges:=True
End Sub





Plz see the changes that i made as per my needs
& I have to remove this line & wanted to remove the limitation of this macro
Dim Lr1 As Long, Lr2 As Long: Let Lr1 = 5000: Lr2 = 5000 plz suggest instead of this what i have to use & u already shared similar solution but i need cnfirmation from u so plz see and let me know again sir

[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

[fixer]

Sub STEP11()

Dim wbk1 As Workbook
Dim wsh1 As Worksheet

Application.ScreenUpdating = False

Set wbk1 = Workbooks.Open(ThisWorkbook.Path & "\BasketOrder..csv")
Set wsh1 = wbk1.Worksheets(1)

With wsh1
On Error Resume Next
wsh1.Columns("C").SpecialCells(xlCellTypeBlanks).EntireRow.Delete

End With


Application.DisplayAlerts = False
wbk1.Close SaveChanges:=True
Application.DisplayAlerts = True

Application.ScreenUpdating = True

End Sub








Sub STEP12()

Dim wbk1 As Workbook
Dim wsh1 As Worksheet

Application.ScreenUpdating = False

Set wbk1 = Workbooks.Open(ThisWorkbook.Path & "\Error.xlsx")
Set wsh1 = wbk1.Worksheets(1)

With wsh1
On Error Resume Next
wsh1.Columns("C").SpecialCells(xlCellTypeBlanks).EntireRow.Delete

End With


Application.DisplayAlerts = False
wbk1.Close SaveChanges:=True
Application.DisplayAlerts = True

Application.ScreenUpdating = True

End Sub





These code works perfect
But as per recommendation this macro has on error resume next ,so i wanted to remove on error resume next in the macro & wanted to make it perfect

[DocAElstein]

You must always tell me please what the macro is supposed to do, or else I cannot be sure if the changes are correct.
It might also sometimes help if you upload sample files.

The more infomation I have, the easier it is for me to help, and the more likely that I give a better answer

https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA (https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA)
https://www.youtube.com/watch?v=f7xZivqLZxc&lc=Ugxq4JHRza_zx3sz0fx4AaABAg (https://www.youtube.com/watch?v=f7xZivqLZxc&lc=Ugxq4JHRza_zx3sz0fx4AaABAg)
https://www.youtube.com/watch?v=f7xZivqLZxc&lc=UgzMCQUIQgrbec400jl4AaABAg (https://www.youtube.com/watch?v=f7xZivqLZxc&lc=UgzMCQUIQgrbec400jl4AaABAg)
https://www.youtube.com/watch?v=f7xZivqLZxc&lc=UgwhVTFaD469mW9wO194AaABAg.9gJzxwFcnPU9gORqKw5t W_ (https://www.youtube.com/watch?v=f7xZivqLZxc&lc=UgwhVTFaD469mW9wO194AaABAg.9gJzxwFcnPU9gORqKw5t W_)
https://www.youtube.com/watch?v=f7xZivqLZxc&lc=Ugyb8nmKKoXvcdM58gV4AaABAg (https://www.youtube.com/watch?v=f7xZivqLZxc&lc=Ugyb8nmKKoXvcdM58gV4AaABAg)
https://www.youtube.com/watch?v=f7xZivqLZxc&lc=UgwvvXcl1oa79xS7BAV4AaABAg (https://www.youtube.com/watch?v=f7xZivqLZxc&lc=UgwvvXcl1oa79xS7BAV4AaABAg)
https://www.youtube.com/watch?v=f7xZivqLZxc&lc=UgxvIFArksPprylHXYZ4AaABAg (https://www.youtube.com/watch?v=f7xZivqLZxc&lc=UgxvIFArksPprylHXYZ4AaABAg)
https://www.youtube.com/watch?v=f7xZivqLZxc&lc=Ugxq4JHRza_zx3sz0fx4AaABAg (https://www.youtube.com/watch?v=f7xZivqLZxc&lc=Ugxq4JHRza_zx3sz0fx4AaABAg)
https://www.youtube.com/watch?v=v_1iqtOnUMg&lc=UgxUbeYSvsBH2Gianox4AaABAg.9VYH-07VTyW9gJV5fDAZNe (https://www.youtube.com/watch?v=v_1iqtOnUMg&lc=UgxUbeYSvsBH2Gianox4AaABAg.9VYH-07VTyW9gJV5fDAZNe)
https://www.youtube.com/watch?v=v_1iqtOnUMg&lc=UgxLtKj969oiIu7zNb94AaABAg (https://www.youtube.com/watch?v=v_1iqtOnUMg&lc=UgxLtKj969oiIu7zNb94AaABAg)
https://www.youtube.com/watch?v=v_1iqtOnUMg&lc=UgyhQ73u0C3V4bEPhYB4AaABAg (https://www.youtube.com/watch?v=v_1iqtOnUMg&lc=UgyhQ73u0C3V4bEPhYB4AaABAg)
https://www.youtube.com/watch?v=v_1iqtOnUMg&lc=UgzIElpI5OFExnUyrk14AaABAg.9fsvd9zwZii9gMUka-NbIZ (https://www.youtube.com/watch?v=v_1iqtOnUMg&lc=UgzIElpI5OFExnUyrk14AaABAg.9fsvd9zwZii9gMUka-NbIZ)
https://www.youtube.com/watch?v=jdPeMPT98QU (https://www.youtube.com/watch?v=jdPeMPT98QU)
https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA (https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA)

[DocAElstein]

Where does the original macro come from
What is it supposed to do

[DocAElstein]

Where does the original macro come from.
What is it supposed to do.


https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA (https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA)
https://www.youtube.com/watch?v=QdwDnUz96W0&lc=Ugx3syV3Bw6bxddVyBx4AaABAg (https://www.youtube.com/watch?v=QdwDnUz96W0&lc=Ugx3syV3Bw6bxddVyBx4AaABAg)
https://www.youtube.com/watch?v=U76ZRIzBhOA&lc=UgxsozCmRd3RAmIPO5B4AaABAg.9fxrOrrvTln9g9wr8mv2 CS (https://www.youtube.com/watch?v=U76ZRIzBhOA&lc=UgxsozCmRd3RAmIPO5B4AaABAg.9fxrOrrvTln9g9wr8mv2 CS)
https://www.youtube.com/watch?v=U76ZRIzBhOA&lc=Ugw6zxOMtNCfmdllKQl4AaABAg (https://www.youtube.com/watch?v=U76ZRIzBhOA&lc=Ugw6zxOMtNCfmdllKQl4AaABAg)
https://www.youtube.com/watch?v=U76ZRIzBhOA&lc=UgyT1lo2YMUyZ50bLeR4AaABAg.9fz3_oaiUeK9g96yGbAX 4t (https://www.youtube.com/watch?v=U76ZRIzBhOA&lc=UgyT1lo2YMUyZ50bLeR4AaABAg.9fz3_oaiUeK9g96yGbAX 4t)
https://www.youtube.com/watch?v=U76ZRIzBhOA&lc=Ugx5d-LrmoMM_hsJK2N4AaABAg.9fyL20jCtOI9g7pczEpcTz (https://www.youtube.com/watch?v=U76ZRIzBhOA&lc=Ugx5d-LrmoMM_hsJK2N4AaABAg.9fyL20jCtOI9g7pczEpcTz)
https://www.youtube.com/watch?v=U76ZRIzBhOA&lc=UgyT1lo2YMUyZ50bLeR4AaABAg.9fz3_oaiUeK9g7lhoX-ar5 (https://www.youtube.com/watch?v=U76ZRIzBhOA&lc=UgyT1lo2YMUyZ50bLeR4AaABAg.9fz3_oaiUeK9g7lhoX-ar5)
https://www.youtube.com/watch?v=U76ZRIzBhOA&lc=Ugx5d-LrmoMM_hsJK2N4AaABAg.9fyL20jCtOI9gD0AA-sfpl (https://www.youtube.com/watch?v=U76ZRIzBhOA&lc=Ugx5d-LrmoMM_hsJK2N4AaABAg.9fyL20jCtOI9gD0AA-sfpl )
https://www.youtube.com/watch?v=U76ZRIzBhOA&lc=Ugx5d-LrmoMM_hsJK2N4AaABAg.9fyL20jCtOI9gECpsAVGbh (https://www.youtube.com/watch?v=U76ZRIzBhOA&lc=Ugx5d-LrmoMM_hsJK2N4AaABAg.9fyL20jCtOI9gECpsAVGbh)
https://www.youtube.com/watch?v=U76ZRIzBhOA&lc=Ugw6zxOMtNCfmdllKQl4AaABAg.9g9wJCunNRa9gJGhDZ4R I2 (https://www.youtube.com/watch?v=U76ZRIzBhOA&lc=Ugw6zxOMtNCfmdllKQl4AaABAg.9g9wJCunNRa9gJGhDZ4R I2)
https://www.youtube.com/watch?v=Sh1kZD7EVj0&lc=Ugz-pow-E8FDG8gFZ4l4AaABAg.9f8Bng22e5d9f8hoJGZY-5 (https://www.youtube.com/watch?v=Sh1kZD7EVj0&lc=Ugz-pow-E8FDG8gFZ4l4AaABAg.9f8Bng22e5d9f8hoJGZY-5)
https://www.youtube.com/watch?v=Sh1kZD7EVj0&lc=Ugxev2gQt7BKZ0WYMfh4AaABAg.9f6hAjkC0ct9f8jleOui-u (https://www.youtube.com/watch?v=Sh1kZD7EVj0&lc=Ugxev2gQt7BKZ0WYMfh4AaABAg.9f6hAjkC0ct9f8jleOui-u)
https://www.youtube.com/watch?v=Sh1kZD7EVj0&lc=Ugxg9iT7MPWGBWruIzR4AaABAg (https://www.youtube.com/watch?v=Sh1kZD7EVj0&lc=Ugxg9iT7MPWGBWruIzR4AaABAg)
https://www.youtube.com/watch?v=tzbKqTRuRzU&lc=UgyYW2WZ2DvSrzUKnJ14AaABAg (https://www.youtube.com/watch?v=tzbKqTRuRzU&lc=UgyYW2WZ2DvSrzUKnJ14AaABAg)
https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA (https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA)

https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA (https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA)
https://www.youtube.com/watch?v=jTmVtPHtiTg&lc=Ugy_RiNN_kAqUvZ8W994AaABAg (https://www.youtube.com/watch?v=jTmVtPHtiTg&lc=Ugy_RiNN_kAqUvZ8W994AaABAg)
https://www.youtube.com/watch?v=QjEWAJ3d-jw&lc=UgxJLVpwY8fIla7G-pN4AaABAg.9BLeCWVhxdG9wgNsaS3Lp1 (https://www.youtube.com/watch?v=QjEWAJ3d-jw&lc=UgxJLVpwY8fIla7G-pN4AaABAg.9BLeCWVhxdG9wgNsaS3Lp1)
https://www.youtube.com/watch?v=QjEWAJ3d-jw&lc=UgxJLVpwY8fIla7G-pN4AaABAg.9BLeCWVhxdG9wgR1EPUkhw (https://www.youtube.com/watch?v=QjEWAJ3d-jw&lc=UgxJLVpwY8fIla7G-pN4AaABAg.9BLeCWVhxdG9wgR1EPUkhw)
https://www.youtube.com/watch?v=QjEWAJ3d-jw&lc=UgxJLVpwY8fIla7G-pN4AaABAg.9BLeCWVhxdG9wgNe_XC-jK (https://www.youtube.com/watch?v=QjEWAJ3d-jw&lc=UgxJLVpwY8fIla7G-pN4AaABAg.9BLeCWVhxdG9wgNe_XC-jK)
https://www.youtube.com/watch?v=QjEWAJ3d-jw&lc=UgxJLVpwY8fIla7G-pN4AaABAg.9BLeCWVhxdG9wgNPOdiDuv (https://www.youtube.com/watch?v=QjEWAJ3d-jw&lc=UgxJLVpwY8fIla7G-pN4AaABAg.9BLeCWVhxdG9wgNPOdiDuv)
https://www.youtube.com/watch?v=QjEWAJ3d-jw&lc=UgxJLVpwY8fIla7G-pN4AaABAg.9BLeCWVhxdG9wgN7AC7wAc (https://www.youtube.com/watch?v=QjEWAJ3d-jw&lc=UgxJLVpwY8fIla7G-pN4AaABAg.9BLeCWVhxdG9wgN7AC7wAc)
https://www.youtube.com/watch?v=bs-urI_o8jo&lc=UgyBACXgNY4j_cHgH5J4AaABAg.9oTkVdzfqfm9wlhQrYJP 3M (https://www.youtube.com/watch?v=bs-urI_o8jo&lc=UgyBACXgNY4j_cHgH5J4AaABAg.9oTkVdzfqfm9wlhQrYJP 3M)
https://www.youtube.com/watch?v=bs-urI_o8jo&lc=UgxYgiEZuS9I3xkjJv54AaABAg (https://www.youtube.com/watch?v=bs-urI_o8jo&lc=UgxYgiEZuS9I3xkjJv54AaABAg)
https://www.youtube.com/watch?v=DVFFApHzYVk&lc=Ugyi578yhj9zShmhuPl4AaABAg (https://www.youtube.com/watch?v=DVFFApHzYVk&lc=Ugyi578yhj9zShmhuPl4AaABAg)
https://www.youtube.com/watch?v=GqzeFYWjTxI&lc=UgxvxlnuTRWiV6MUZB14AaABAg (https://www.youtube.com/watch?v=GqzeFYWjTxI&lc=UgxvxlnuTRWiV6MUZB14AaABAg)
https://www.youtube.com/watch?v=_8i1fVEi5WY&lc=Ugz0ptwE5J-2CpX4Lzh4AaABAg (https://www.youtube.com/watch?v=_8i1fVEi5WY&lc=Ugz0ptwE5J-2CpX4Lzh4AaABAg)
https://www.youtube.com/watch?v=0ltJS7uHfK4&lc=UgxoHAw8RwR7VmyVBUt4AaABAg.9C-br0lEl8V9xI0_6pCaR9 (https://www.youtube.com/watch?v=0ltJS7uHfK4&lc=UgxoHAw8RwR7VmyVBUt4AaABAg.9C-br0lEl8V9xI0_6pCaR9)
https://www.youtube.com/watch?v=0ltJS7uHfK4&lc=Ugz5DDCMqmHLeEjUU8t4AaABAg.9bl7m03Onql9xI-ar3Z0ME (https://www.youtube.com/watch?v=0ltJS7uHfK4&lc=Ugz5DDCMqmHLeEjUU8t4AaABAg.9bl7m03Onql9xI-ar3Z0ME)
https://www.youtube.com/watch?v=0ltJS7uHfK4&lc=UgxYnpd9leriPmc8rPd4AaABAg.9gdrYDocLIm9xI-2ZpVF-q (https://www.youtube.com/watch?v=0ltJS7uHfK4&lc=UgxYnpd9leriPmc8rPd4AaABAg.9gdrYDocLIm9xI-2ZpVF-q)
https://www.youtube.com/watch?v=0ltJS7uHfK4&lc=UgyjoPLjNeIAOMVH_u94AaABAg.9id_Q3FO8Lp9xHyeYSuv 1I (https://www.youtube.com/watch?v=0ltJS7uHfK4&lc=UgyjoPLjNeIAOMVH_u94AaABAg.9id_Q3FO8Lp9xHyeYSuv 1I)
https://www.reddit.com/r/windowsxp/comments/pexq9q/comment/k81ybvj/?utm_source=reddit&utm_medium=web2x&context=3 (https://www.reddit.com/r/windowsxp/comments/pexq9q/comment/k81ybvj/?utm_source=reddit&utm_medium=web2x&context=3)
https://www.youtube.com/watch?v=bs-urI_o8jo&lc=UgxYgiEZuS9I3xkjJv54AaABAg (https://www.youtube.com/watch?v=bs-urI_o8jo&lc=UgxYgiEZuS9I3xkjJv54AaABAg)
https://www.youtube.com/watch?v=bs-urI_o8jo&lc=UgyBACXgNY4j_cHgH5J4AaABAg.9oTkVdzfqfm9wlhQrYJP 3M (https://www.youtube.com/watch?v=bs-urI_o8jo&lc=UgyBACXgNY4j_cHgH5J4AaABAg.9oTkVdzfqfm9wlhQrYJP 3M)
ttps://www.youtube.com/watch?v=LP9fz2DCMBE (ttps://www.youtube.com/watch?v=LP9fz2DCMBE)
https://www.youtube.com/watch?v=LP9fz2DCMBE&lc=UgzbPgJUMCztIOQDym14AaABAg (https://www.youtube.com/watch?v=LP9fz2DCMBE&lc=UgzbPgJUMCztIOQDym14AaABAg)
https://www.youtube.com/watch?v=LP9fz2DCMBE&lc=UgzbPgJUMCztIOQDym14AaABAg.9wdo_rWgxSH9wdpcYqrv p8 (https://www.youtube.com/watch?v=LP9fz2DCMBE&lc=UgzbPgJUMCztIOQDym14AaABAg.9wdo_rWgxSH9wdpcYqrv p8)
ttps://www.youtube.com/watch?v=bFxnXH4-L1A (ttps://www.youtube.com/watch?v=bFxnXH4-L1A)
https://www.youtube.com/watch?v=bFxnXH4-L1A&lc=UgxuODisjo6cvom7O-B4AaABAg.9w_AeS3JiK09wdi2XviwLG (https://www.youtube.com/watch?v=bFxnXH4-L1A&lc=UgxuODisjo6cvom7O-B4AaABAg.9w_AeS3JiK09wdi2XviwLG)
https://www.youtube.com/watch?v=bFxnXH4-L1A&lc=UgxBU39bTptFznDC1PJ4AaABAg (https://www.youtube.com/watch?v=bFxnXH4-L1A&lc=UgxBU39bTptFznDC1PJ4AaABAg)
ttps://www.youtube.com/watch?v=GqzeFYWjTxI (ttps://www.youtube.com/watch?v=GqzeFYWjTxI)
https://www.youtube.com/watch?v=GqzeFYWjTxI&lc=UgwJnJDJ5JT8hFvibt14AaABAg (https://www.youtube.com/watch?v=GqzeFYWjTxI&lc=UgwJnJDJ5JT8hFvibt14AaABAg)
https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA (https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA)

[fixer]

I got this macro in 2019 & I have not remebered from which forum i got this macro
I am sending the sample file plz give me some time

[fixer]

I got this macro in 2019 & I have not remebered from which forum i got this macro
I am sending the sample file plz give me some time

[fixer]

I am sending the sample file plz give me some time

[fixer]

Sub STEP7()
Dim Wb1 As Workbook
Dim wb3 As Workbook
Dim Ws1 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("B" & Ws1.Rows.Count).End(xlUp).Row
strPath = ThisWorkbook.Path & "\"
Set wb3 = Workbooks.Open(strPath & "BasketOrder..csv")
Set ws3 = wb3.Worksheets(1)
Set rng = ws3.Range("C:C").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
ws3.Range("C" & n).Value = Ws1.Range("B" & r).Value
n = n + 1
Next r
Application.DisplayAlerts = False
wb3.SaveAs FileName:=strPath & "BasketOrder..csv", FileFormat:=xlCSV
wb3.Close SaveChanges:=False
Wb1.Close SaveChanges:=False
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub


I have this macro which is working perfect but i converted the basketorder..csv to basketorder.xlsx so i need the modification according to that
plz see the sample file
condition: Copy column B data of 1.xls and paste it to column C of basketorder.xlsx(exclude the header of column B of 1.xls and simply paste the rest data to column C of basketorder.xlsx )

[DocAElstein]

Hi,

I think maybe you have got something mixed up or wrong….

The macro you posted seems unnecessarily very complicate. It may be complicated for reasons and issues that I do not know about. That is why , as ever, it is always important for me to know where you got the macro from
Where did you get this macro from?
Are you sure that your explanation is correct? I think that is probably not what you want. If it is then that macro you posted is probably not the one that you meant to…


Copy column B data of 1.xls and paste it to column C of basketorder.xlsx(exclude the header of column B of 1.xls and simply paste the rest data to column C of basketorder.xlsx
= copy 1.xls B2:B5 to C1:C4 BasketOrder.xlsx

If that is what you want , then you need just one code line like

' https://excelfox.com/forum/showthread.php/2563-copy-and-paste-by-VBA-based-on-criteria?p=14104&viewfull=1#post14104
Ws2.Range(“C1:C4”).Value = Ws1.Range(“B2:B5”)

Or like

' https://excelfox.com/forum/showthread.php/2563-copy-and-paste-by-VBA-based-on-criteria?p=14100&viewfull=1#post14100
Ws1.Range(“B2:B5”).Copy
Ws2.Range(“C1:C4”) .PasteSpecial Paste:= xlPasteValues


That you have been doing that now for 2 years, here one example https://excelfox.com/forum/showthread.php/2563-copy-and-paste-by-VBA-based-on-criteria?p=14104&viewfull=1#post14104
https://excelfox.com/forum/showthread.php/2563-copy-and-paste-by-VBA-based-on-criteria?p=14100&viewfull=1#post14100 .
I and others have shown you how to do that 100 times.
( And you just need to make the last row dynamic)



Alan




Sub DimPigSht4Brains1()
Dim Ws1 As Worksheet, Ws2 As Worksheet, Lr1 As Long, Lr2 As Long
Set Ws1 = Workbooks("1.xls").Worksheets.Item(1): Set Ws2 = Workbooks("BasketOrder.xlsx").Worksheets.Item(1)
Let Lr1 = Ws1.Range("A" & Ws1.Rows.Count).End(xlUp).Row: Let Lr2 = Ws2.Range("A" & Ws1.Rows.Count).End(xlUp).Row
Let Ws2.Range("C1:C4").Value = Ws1.Range("B2:B5").Value
End Sub



Sub DimPigSht4Brains2()
Dim Ws1 As Worksheet, Ws2 As Worksheet, Lr1 As Long, Lr2 As Long
Set Ws1 = Workbooks("1.xls").Worksheets.Item(1): Set Ws2 = Workbooks("BasketOrder.xlsx").Worksheets.Item(1)
Let Lr1 = Ws1.Range("A" & Ws1.Rows.Count).End(xlUp).Row: Let Lr2 = Ws2.Range("A" & Ws1.Rows.Count).End(xlUp).Row
Ws1.Range("B2:B5").Copy
Ws2.Range("C1:C4").PasteSpecial Paste:=xlPasteValues
End Sub

[fixer]

Yes i tried by both methods but i am unable to solve it
I tried by the code also which u shared the link & it was similar to this but there is small change between both macros & i am unable to solve the same
So plz help

Sub DimPigSht4Brains1()
Dim Ws1 As Worksheet, Ws2 As Worksheet, Lr1 As Long, Lr2 As Long
Set Ws1 = Workbooks.Open("C:\Users\WolfieeeStyle\Desktop\sample1.xls").Worksheets.Item(1): Set Ws2 = Workbooks.Open("C:\Users\WolfieeeStyle\Desktop\sample2.xlsx").Worksheets.Item(1)
Let Lr1 = Ws1.Range("A" & Ws1.Rows.Count).End(xlUp).Row: Let Lr2 = Ws2.Range("A" & Ws1.Rows.Count).End(xlUp).Row
Let Ws2.Range("C:C").Value = Ws1.Range("B2:B").Value
End Sub

[DocAElstein]

You don’t seem to have read or understood anything I wrote, and your last reply is total rubbish and nonsense.
Go back to post 2, https://excelfox.com/forum/showthread.php/2589-Macro-Correction?p=14665&viewfull=1#post14665 , take your time, and try again

I am not going to keep wasting my time saying the same thing over and over again! , and think before you post! , - don’t just post any rubbish and nonsense in the hope that we will magically guess what it is you want

[DocAElstein]

I got this macro in 2019 & I have not remebered from which forum i got this macro
So look for it and find it

[DocAElstein]

I got this macro in 2019 & I have not remebered from which forum i got this macro
So look for it and find it

[fixer]

http://www.eileenslounge.com/viewtopic.php?f=30&t=34998

[fixer]

http://www.eileenslounge.com/viewtopic.php?f=30&t=34996

[fixer]

Sub STEP7()
Dim Wb1 As Workbook
Dim wb3 As Workbook
Dim Ws1 As Worksheet
Dim ws3 As Worksheet
Dim r As Long
Dim m As Long
Dim rng As Range
Dim n As Long
Application.ScreenUpdating = False
Set Wb1 = Workbooks.Open("C:\Users\WolfieeeStyle\Desktop\1.xls")
Set Ws1 = Wb1.Worksheets(1)
m = Ws1.Range("B" & Ws1.Rows.Count).End(xlUp).Row
Set wb3 = Workbooks.Open("C:\Users\WolfieeeStyle\Desktop\BasketOrder.xlsx")
Set ws3 = wb3.Worksheets(1)
Set rng = ws3.Range("C:C").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
ws3.Range("C" & n).Value = Ws1.Range("B" & r).Value
n = n + 1
Next r
Application.DisplayAlerts = False
wb3.Close SaveChanges:=True
Wb1.Close SaveChanges:=False
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub




Problem Solved
Thnx Alot Doc Sir for helping me in solving this Problem
Have a Great Day

[fixer]

This Problem is Already Solved


Sub STEP8()
Dim arrWbs() As Variant
Let arrWbs() = Array("C:\Users\WolfieeeStyle\Desktop\A.xlsx", "C:\Users\WolfieeeStyle\Desktop\Files\B.xlsx")

Dim Wb As Workbook, Ws As Worksheet

Dim Stear As Variant
For Each Stear In arrWbs()
' 2a Worksheets data info
Set Wb = Workbooks.Open(Stear)

Set Ws = Wb.Worksheets.Item(1)
Dim LrC As Long: Let LrC = Ws.Range("C" & Ws.Rows.Count & "").End(xlUp).Row
Dim Lc As Long: Let Lc = Ws.UsedRange.Columns.Count - Ws.UsedRange.Column + 1
Dim arrC() As Variant: Let arrC() = Ws.Range("C1:C" & LrC & "").Value2

Dim Cnt As Long
For Cnt = 1 To LrC
Dim strRws As String
If arrC(Cnt, 1) <> "" Then Let strRws = strRws & Cnt & " "
Next Cnt
Let strRws = Left(strRws, Len(strRws) - 1)

Dim Rws() As String: Let Rws() = Split(strRws, " ", -1, vbBinaryCompare)
Dim RwsT() As Variant: ReDim RwsT(1 To UBound(Rws) + 1, 1 To 1)
For Cnt = 1 To UBound(Rws) + 1
Let RwsT(Cnt, 1) = Rws(Cnt - 1)
Next Cnt

Dim Clms() As Variant
'
Let Clms() = Evaluate("=Column(A:" & CL(Lc) & ")")
Dim arrOut() As Variant
Let arrOut() = Application.Index(Ws.Cells, RwsT(), Clms())

Ws.Cells.ClearContents
Let Ws.Range("A1").Resize(UBound(arrOut(), 1), 21).Value2 = arrOut()

Let strRws = ""
Wb.Save
Wb.Close
Next Stear
End Sub


Public Function CL(ByVal lclm As Long) As String
Do: Let CL = Chr(65 + (((lclm - 1) Mod 26))) & CL: Let lclm = (lclm - (1)) \ 26: Loop While lclm > 0
End Function

[fixer]

Problem Solved
Thnx Alot Doc Sir for helping me in solving this Problem
Have a Awesome Day

[DocAElstein]

with one macro both the problem has been solved
So what you are possibly trying to say is something similar to , you don’t need the macro anymore, as the one you pasted ( https://excelfox.com/forum/showthread.php/2586-Macro-Correction?p=14691&viewfull=1#post14691 which comes from another Thread, https://excelfox.com/forum/showthread.php/2364-Delete-rows-based-on-match-criteria-in-two-excel-files?p=14676&viewfull=1#post14676
https://excelfox.com/forum/showthread.php/2577-Appendix-Thread-(-Codes-for-other-Threads-(-Avinash-)-)/page29#post14663
) makes that macro no longer needed.

Your bad explanations, or lack of an explanations, as in this case, makes things very confusing for others reading this post…
You still need to try to improve on you replies and explanations.

[fixer]

First I have reported this thread that plz delete this thread & then i started a new thread which is doing the same thing with one macro only & that u have already answered
So Doc Sir this problem is already solved by u sir
& Thnx For helping me in solving the same Sir

[DocAElstein]

I think it will be impossible for anybody to answer these questions for you.
This is because of many reasons.

_ 1 Most of your postings are rubbish
_ 2 You seem unwilling or unable to find the files or original source of these macros. Without this information you are making a question 100 times more difficult for anyone to answer. I can only assume, that as in many cases in the past , you are deliberately withholding this information to keep secret from us another one of your many accounts at one of the few remaining sources where you are still getting help. In so doing you are making life more difficult for everyone, including yourself, and are wasting everyone’s time. You are not smart in doing this, you are being a complete dim pig shit for brains selfish ignorant twat
_ 3 Any attempt to communicate with you in English fails. You just reply with nonsense

_ I can’t understand why you post such nonsense.
As often, you seem to be expecting someone to be like God, and magically guess what you want.

It appears that with questions like this you have no idea at all what is going on.
So you saying something like this…

....I have these code it works perfect.... is a total lie and rubbish. You don’t seem to have any idea at all about what these macros are or what they are doing or where they come from.
How can you possibly know that the macro works perfectly when you haven't been able to find any files that it works on.
I think I could spend some time to understand what these macros are doing, and then write a macro to do similar with excel files, instead of text files.

But it would be pointless. You would never understand the answer and we would once again go around in endless time wasting circles
If you have a boss or someone else driving you to make these senseless postings, then you need to tell that miserable obnoxious mother fucking cunt who is hiding behind you to stop pissing about with us all and show his cowardly face and speak for himself.

[DocAElstein]

The macro you posted in your last post , and the macro at the cross post where you appeared to have a solution, and everything you posted here are all different things.
You are posting a lot of mixed up nonsense ,

[fixer]

Mistake corrected here http://www.eileenslounge.com/viewtopic.php?f=30&t=34998
it was simply copy & paste issue

[DocAElstein]

...it was simply copy & paste issue
No, it isn't/ wasn't.
My posts explained in detail a simple copy and paste.
You said that was not what you wanted.
As always you are just in a total mess and don't have a fucking clue about anything to do with what you are attempting to do., and most of your similar postings are just wasting everybody's time…



I have banned you again, temporarily, to give us a break from you.

You seem to have recently discovered excelforum, ( and most likely a few other places you are keeping secret from us), as a good place, or places, to hide multiple accounts and duplicated cross postings, so I guess you will have no problem continuing your strategy of positing duplicated poorly explained similar postings , seemingly hoping that someone will magically supply a macro or macros that solve some problem that you don't seem yourself to have any clue about most of the time..
( Possibly someone else is driving you, ( or something in your brain is driving you that probably needs surgery to remove…) )

[DocAElstein]

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..