Appendix Thread. ( Codes for other Threads, ( Avinash ).)

[DocAElstein]

Question 1

Solution for this question, ( 2020-05-28 22:13:09 Rajesh Kumar )
https://excel.tips.net/T002145_Dynamic_Worksheet_Tab_Names.html



Question: ( Question 1 )
......I have a list of 80 students. I have made 80 sheets, 1 sheet for 1 student. I want to rename these 80 sheets on the basis of the name in the list, so that whenever I update the name list, the corresponding sheet-name changed automatically. I'm a beginner in this field. Please help me.

Solution.
Hello Rajesh
This requirement is fairly easy with VBA

There are 3 macros which I have written for you, and I am returning 2 workbook examples

Macro for your original requirement
Private Sub Worksheet_Change(ByVal Target As Range)
This macro is in both workbooks:
It does this: If you change any of your names in column B of the worksheets, then the name of the corresponding worksheet tab Name will change, as per your main original requirement.

Workbook AddNamesfromListToExistingWorksheets.xlsm
This is the workbook supplied by you. It has initially 80 student names in column B of the first worksheet. It has 80 additional worksheets , as made by you, with the names of 1 2 3 4 5 …. Etc.
This workbook has a macro , Sub ChangeNamesToExistingWorksheets() . This macro replaces those names with the names from the Student name list in column B

Workbook AddWorksheetsNamedFromList.xlsm
This is your original Workbook, with all but the first worksheet deleted. So this only contains one worksheet containing your list of student Names in column B
In this workbook, there is a macro, Sub AddWorksheetsfromListOfNames()
This macro adds worksheets with the student Names



Note: in your supplied data, you had two identical names at row 26 and at row 75, SACHIN KUMAR , so I changed it to SACHIN KUMAR 2 in row 75
( We could handle such cases in coding, automatically, later if you preferred )


Alan



Workbooks:
Share ‘AddNamesfromListToExistingWorksheets.xlsm’ : https://app.box.com/s/2ytj6qrsyaudh3tzgtodls8l05zn1woz
Share ‘AddWorksheetsNamedFromList.xlsm’ : https://app.box.com/s/yljwyk5ykxtjt2qhzvdpwcrft19phx54
For macros, see also post https://excelfox.com/forum/showthread.php/2345-Appendix-Thread-(-Codes-for-other-Threads-HTML-Tables-etc-)?p=13443&viewfull=1#post13444




Cross posts
https://excel.tips.net/T002145_Dynamic_Worksheet_Tab_Names.html ( 2020-05-28 22:13:09 Rajesh Kumar ) https://excel.tips.net/T002145_Dynamic_Worksheet_Tab_Names.html
https://www.mrexcel.com/board/threads/vba-for-dynamic-sheets-name-dynamic-link-hide-sheets-based-on-a-cell-value.1135674/ https://www.mrexcel.com/board/threads/vba-for-dynamic-sheets-name-dynamic-link-hide-sheets-based-on-a-cell-value.1135674/

[DocAElstein]

Macros for this post ( Question 1 )
https://excelfox.com/forum/showthread.php/2345-Appendix-Thread-(-Codes-for-other-Threads-HTML-Tables-etc-)?p=13443&viewfull=1#post13443


Option Explicit

' https://excel.tips.net/T002145_Dynamic_Worksheet_Tab_Names.html ' https://excelfox.com/forum/showthread.php/2345-Appendix-Thread-(-Codes-for-other-Threads-HTML-Tables-etc-)?p=13443&viewfull=1#post13443 https://excelfox.com/forum/showthread.php/2345-Appendix-Thread-(-Codes-for-other-Threads-HTML-Tables-etc-)?p=13443&viewfull=1#post13444

Sub RemoveAllButThisWorksheet()
Dim Cnt
For Cnt = ThisWorkbook.Worksheets.Count To 2 Step -1 ' second worksheet counting tab from the left is worksheets item 2
Let Application.DisplayAlerts = False
ThisWorkbook.Worksheets.Item(Cnt).Delete
Let Application.DisplayAlerts = True
Next Cnt
End Sub
Sub ChangeNamesToExistingWorksheets() '
Rem 0
On Error GoTo Bed ' If we have problems then we want to make sure that we still re enable Events coding before ending the macro
Let Application.EnableEvents = False ' This will prevent anything we do in this macro from causing erratic working of any automatic event coding
Rem 1 worksheets 1 info
Dim Ws1 As Worksheet
Set Ws1 = ThisWorkbook.Worksheets.Item(1) ' or Worksheets("Name List") ' first worksheet counting tab from the left is worksheets item 1
Dim Lr1 As Long
Let Lr1 = Ws1.Range("B" & Ws1.Rows.Count & "").End(xlUp).Row ' http://www.excelfox.com/forum/showthread.php/2345-Appendix-Thread-(-Codes-for-other-Threads-HTML-Tables-etc-)?p=11466&viewfull=1#post11466 Making Lr dynamic ( using rng.End(XlUp) for a single column. )
Dim arrNmes() As Variant ' The .Value2 property in the next line will return a field of values housed in Variant type Elements, so we need to give the variant type to our array used to capture that array of values
Let arrNmes() = Ws1.Range("B1:B" & Lr1 & "").Value2
Rem 2 Add and name worksheets from list
Dim Cnt As Long
For Cnt = 2 To UBound(arrNmes(), 1) ' From (2,1) To (2,Lr1) in names array list column 2 ( column B )
Let Worksheets.Item(Cnt).Name = arrNmes(Cnt, 1)
Next Cnt
Bed: ' error handling code section.
Let Application.EnableEvents = True
End Sub

Sub AddWorksheetsfromListOfNames()
Rem 0
On Error GoTo Bed
Let Application.EnableEvents = False
Rem 1 worksheets 1 info
Dim Ws1 As Worksheet
Set Ws1 = ThisWorkbook.Worksheets.Item(1) ' or Worksheets("Name List") ' first worksheet counting tab from the left is worksheets item 1
Dim Lr1 As Long
Let Lr1 = Ws1.Range("B" & Ws1.Rows.Count & "").End(xlUp).Row ' http://www.excelfox.com/forum/showthread.php/2345-Appendix-Thread-(-Codes-for-other-Threads-HTML-Tables-etc-)?p=11466&viewfull=1#post11466 Making Lr dynamic ( using rng.End(XlUp) for a single column. )
Dim arrNmes() As Variant
Let arrNmes() = Ws1.Range("B1:B" & Lr1 & "").Value2
Rem 2 Add and name worksheets from list
Dim Cnt As Long
For Cnt = 2 To UBound(arrNmes(), 1) ' From (2,1) To (2,Lr1) in names array list column 2
Worksheets.Add After:=Worksheets.Item(Worksheets.Count)
Let ActiveSheet.Name = arrNmes(Cnt, 1)
Next Cnt

Bed:
Let Application.EnableEvents = True
End Sub
'
'

Private Sub Worksheet_Change(ByVal Target As Range)
If IsArray(Target.Value) Then Exit Sub ' If we have changed more than 1 cell, our code lines below will error, so best do nothing in such a case
Dim Ws1 As Worksheet
Set Ws1 = Me
Dim Lr1 As Long
Let Lr1 = Ws1.Range("B" & Ws1.Rows.Count & "").End(xlUp).Row ' http://www.excelfox.com/forum/showthread.php/2345-Appendix-Thread-(-Codes-for-other-Threads-HTML-Tables-etc-)?p=11466&viewfull=1#post11466 Making Lr dynamic ( using rng.End(XlUp) for a single column. )

Dim Rng As Range
Set Rng = Ws1.Range("B2:B" & Lr1 & "")
If Not Intersect(Rng, Target) Is Nothing Then ' The Excel VBA Application.Intersect method returns the range where all the given ranges cross, or Nothing if there are no common cells. So, in this example, we would have Nothing if our selection ( which VBA supplies in Target ) , did not cross our names list ' https://docs.microsoft.com/en-us/office/vba/api/excel.application.intersect
Dim Rw As Long
Let Rw = Target.Row
Let ThisWorkbook.Worksheets.Item(Rw).Name = Target.Value ' In the list, each row number corresponds to the item number of our worksheets made from that list
Else
' changed cell was not in Student name list
End If

End Sub






Cross posts
https://excel.tips.net/T002145_Dynamic_Worksheet_Tab_Names.html ( 2020-05-28 22:13:09 Rajesh Kumar ) https://excel.tips.net/T002145_Dynamic_Worksheet_Tab_Names.html
https://www.mrexcel.com/board/threads/vba-for-dynamic-sheets-name-dynamic-link-hide-sheets-based-on-a-cell-value.1135674/ https://www.mrexcel.com/board/threads/vba-for-dynamic-sheets-name-dynamic-link-hide-sheets-based-on-a-cell-value.1135674/

[DocAElstein]

Macro for these posts ( Question 2 )
https://excelfox.com/forum/showthread.php/2501-VBA-for-dynamic-sheets-name-dynamic-link-hide-sheets-based-on-a-cell-Value?p=13442&viewfull=1#post13442
https://excelfox.com/forum/showthread.php/2501-VBA-for-dynamic-sheets-name-dynamic-link-hide-sheets-based-on-a-cell-Value?p=13448&viewfull=1#post13448


' _1. I want to create 5 tabs (Sheets) on the basis of these 5 names. (Now the workbook will have 6 tabs, including Master Sheet) https://excelfox.com/forum/showthread.php/2501-VBA-for-dynamic-sheets-name-dynamic-link-hide-sheets-based-on-a-cell-Value?p=13445#post13445
Sub AddWorksheetsfromListOfNames2() ' https://excelfox.com/forum/showthread.php/2501-VBA-for-dynamic-sheets-name-dynamic-link-hide-sheets-based-on-a-cell-Value?p=13445#post13445 https://www.mrexcel.com/board/threads/vba-for-dynamic-sheets-name-dynamic-link-hide-sheets-based-on-a-cell-value.1135674/
Rem 0
On Error GoTo Bed ' If we have problems then we want to make sure that we still re enable Events coding before ending the macro
Let Application.EnableEvents = False ' This will prevent anything we do in this macro from causing erratic working of any automatic event coding
Rem 1 worksheets 1 info
Dim Ws1 As Worksheet
Set Ws1 = ThisWorkbook.Worksheets.Item(1) ' or Worksheets("Master Sheet") ' first worksheet counting tab from the left is worksheets item 1
Dim Lr1 As Long
Let Lr1 = Ws1.Range("A" & Ws1.Rows.Count & "").End(xlUp).Row ' http://www.excelfox.com/forum/showthread.php/2345-Appendix-Thread-(-Codes-for-other-Threads-HTML-Tables-etc-)?p=11466&viewfull=1#post11466 Making Lr dynamic ( using rng.End(XlUp) for a single column. )
Dim arrNmes() As Variant
Let arrNmes() = Ws1.Range("A1:A" & Lr1 & "").Value2
Rem 2 Add and name worksheets from list
Dim Cnt As Long
For Cnt = 1 To UBound(arrNmes(), 1) ' From (2,1) To (2,Lr1) in names array list column 1 ( Column A )
Worksheets.Add After:=Worksheets.Item(Worksheets.Count)
Let ActiveSheet.Name = arrNmes(Cnt, 1)
Next Cnt

Bed:
Let Application.EnableEvents = True
End Sub ' (Now the workbook will have 6 tabs, including Master Sheet)

Sub AddHypolinkToWorksheet() ' https://www.mrexcel.com/board/threads/vba-for-dynamic-sheets-name-dynamic-link-hide-sheets-based-on-a-cell-value.1135674/
Rem 0
On Error GoTo Bed ' If we have problems then we want to make sure that we still re enable Events coding before ending the macro
Let Application.EnableEvents = False ' This will prevent anything we do in this macro from causing erratic working of any automatic event coding
Rem 1 worksheets 1 info
Dim Ws1 As Worksheet
Set Ws1 = ThisWorkbook.Worksheets.Item(1) ' or Worksheets("Master Sheet") ' first worksheet counting tab from the left is worksheets item 1
Dim Lr1 As Long
Let Lr1 = Ws1.Range("A" & Ws1.Rows.Count & "").End(xlUp).Row ' http://www.excelfox.com/forum/showthread.php/2345-Appendix-Thread-(-Codes-for-other-Threads-HTML-Tables-etc-)?p=11466&viewfull=1#post11466 Making Lr dynamic ( using rng.End(XlUp) for a single column. )
Dim arrNmes() As Variant
Let arrNmes() = Ws1.Range("A1:A" & Lr1 & "").Value2

Rem 2 Add hyperlinks
Ws1.Hyperlinks.Delete
Dim Cnt
For Cnt = 1 To Lr1 ' ='F:\Excel0202015Jan2016\OffenFragensForums\AllenW yatt\[DynamicWorksheetNamesLinkHideBasedOnCellValue.xlsm]RAHIM'!$A$1
Dim Paf As String: Let Paf = "='" & ThisWorkbook.Path & "\[" & ThisWorkbook.Name & "]" & arrNmes(Cnt, 1) & "'!$A$1"
' Ws1.Hyperlinks.Add Anchor:=Ws1.Range("A" & Cnt & ""), Address:="", SubAddress:="='" & arrNmes(Cnt, 1) & "'!A1", ScreenTip:=arrNmes(Cnt, 1), TextToDisplay:=arrNmes(Cnt, 1)
Ws1.Hyperlinks.Add Anchor:=Ws1.Range("A" & Cnt & ""), Address:="", SubAddress:=Paf, ScreenTip:=arrNmes(Cnt, 1), TextToDisplay:=arrNmes(Cnt, 1)
Next Cnt
Bed: ' error handling code section.
Let Application.EnableEvents = True
End Sub



Private Sub Worksheet_Change(ByVal Target As Range)
If IsArray(Target.Value) Then Exit Sub ' If we have changed more than 1 cell, our code lines below will error, so best do nothing in such a case
Dim Ws1 As Worksheet
Set Ws1 = Me
Dim Lr1 As Long
Let Lr1 = Ws1.Range("A" & Ws1.Rows.Count & "").End(xlUp).Row ' http://www.excelfox.com/forum/showthread.php/2345-Appendix-Thread-(-Codes-for-other-Threads-HTML-Tables-etc-)?p=11466&viewfull=1#post11466 Making Lr dynamic ( using rng.End(XlUp) for a single column. )

Dim Rng As Range
Set Rng = Ws1.Range("A1:A" & Lr1 & "")
If Not Intersect(Rng, Target) Is Nothing Then ' The Excel VBA Application.Intersect method returns the range where all the given ranges cross, or Nothing if there are no common cells. So, in this example, we would have Nothing if our selection ( which VBA supplies in Target ) , did not cross our names list ' https://docs.microsoft.com/en-us/office/vba/api/excel.application.intersect
Dim Rw As Long
Let Rw = Target.Row
If Target.Value = "" Then ' 5. If I delete the content of A1 (ANUJ), i.e, if cell A1 is blank, the corresponding sheet "ANUJ" should hide automatically.
ThisWorkbook.Worksheets.Item(Rw + 1).Visible = False
Exit Sub
Else
ThisWorkbook.Worksheets.Item(Rw + 1).Visible = True
Let ThisWorkbook.Worksheets.Item(Rw + 1).Name = Target.Value ' In the list, each row number corresponds to one less than the item number of our worksheets made from that list
End If
Else
' changed cell was not in Student name list
End If

'
Call AddHypolinkToWorksheet
End Sub





Share ‘DynamicWorksheetNamesLinkHideBasedOnCellValu e. : https://app.box.com/s/louq07ga6uth1508e572l7zr9fakont9

[DocAElstein]

Macros for this post
https://excelfox.com/forum/showthread.php/2501-VBA-for-dynamic-sheets-name-dynamic-link-hide-sheets-based-on-a-cell-Value?p=13456&viewfull=1#post13456

Add Workseets from names list, for example from :

_____ Workbook: DynamicWorksheetNamesLinkHideBasedOnCellValueC.xls m ( Using Excel 2007 32 bit )
Row\Col
B
C
D

3


4ANUJ


5RITA


6MUKESH


7RAM


8RAHIN


9Anshu


10
Worksheet: Master Sheet


' _1. I want to create tabs (Sheets) on the basis of names. https://excelfox.com/forum/showthread.php/2501-VBA-for-dynamic-sheets-name-dynamic-link-hide-sheets-based-on-a-cell-Value?p=13456&viewfull=1#post13456 https://excelfox.com/forum/showthread.php/2501-VBA-for-dynamic-sheets-name-dynamic-link-hide-sheets-based-on-a-cell-Value?p=13445#post13445
Sub AddWorksheetsfromListOfNamesC() ' https://excelfox.com/forum/showthread.php/2501-VBA-for-dynamic-sheets-name-dynamic-link-hide-sheets-based-on-a-cell-Value?p=13456&viewfull=1#post13456 https://excelfox.com/forum/showthread.php/2501-VBA-for-dynamic-sheets-name-dynamic-link-hide-sheets-based-on-a-cell-Value?p=13445#post13445 https://www.mrexcel.com/board/threads/vba-for-dynamic-sheets-name-dynamic-link-hide-sheets-based-on-a-cell-value.1135674/
Rem 0
On Error GoTo Bed ' If we have problems then we want to make sure that we still re enable Events coding before ending the macro
Let Application.EnableEvents = False ' This will prevent anything we do in this macro from causing erratic working of any automatic event coding
Rem 1 worksheets 1 info
Dim Ws1 As Worksheet
Set Ws1 = ThisWorkbook.Worksheets.Item(1) ' or Worksheets("Master Sheet") ' first worksheet counting tab from the left is worksheets item 1
Dim Lr1 As Long
Let Lr1 = Ws1.Range("C" & Ws1.Rows.Count & "").End(xlUp).Row ' Range("A" & Ws1.Rows.Count & "").End(xlUp).Row ' http://www.excelfox.com/forum/showthread.php/2345-Appendix-Thread-(-Codes-for-other-Threads-HTML-Tables-etc-)?p=11466&viewfull=1#post11466 Making Lr dynamic ( using rng.End(XlUp) for a single column. )
Dim arrNmes() As Variant
Let arrNmes() = Ws1.Range("C4:C" & Lr1 & "").Value2 ' Range("A1:A" & Lr1 & "").Value2
Rem 2 Add and name worksheets from list
Dim Cnt As Long
For Cnt = 1 To UBound(arrNmes(), 1) ' From (2,1) To (2,Lr1) in names array list column 1 ( Column A )
Worksheets.Add After:=Worksheets.Item(Worksheets.Count)
Let ActiveSheet.Name = arrNmes(Cnt, 1)
Next Cnt
Worksheets.Item(1).Select
Bed:
Let Application.EnableEvents = True
End Sub '




Add hypelinks to Worksheets


Sub AddHypolinkToWorksheet()
Rem 0
On Error GoTo Bed ' If we have problems then we want to make sure that we still re enable Events coding before ending the macro
Let Application.EnableEvents = False ' This will prevent anything we do in this macro from causing erratic working of any automatic event coding
Rem 1 worksheets 1 info
Dim Ws1 As Worksheet
Set Ws1 = ThisWorkbook.Worksheets.Item(1) ' or Worksheets("Master Sheet") ' first worksheet counting tab from the left is worksheets item 1
Dim Lr1 As Long
Let Lr1 = Ws1.Range("C" & Ws1.Rows.Count & "").End(xlUp).Row ' Range("A" & Ws1.Rows.Count & "").End(xlUp).Row ' http://www.excelfox.com/forum/showthread.php/2345-Appendix-Thread-(-Codes-for-other-Threads-HTML-Tables-etc-)?p=11466&viewfull=1#post11466 Making Lr dynamic ( using rng.End(XlUp) for a single column. )
Dim arrNmes() As Variant
Let arrNmes() = Ws1.Range("C4:C" & Lr1 & "").Value2 ' Range("A1:A" & Lr1 & "").Value2

Rem 2 Add hyperlinks
Ws1.Hyperlinks.Delete
Dim Cnt
For Cnt = 4 To Lr1 ' ='F:\Excel0202015Jan2016\OffenFragensForums\AllenW yatt\[DynamicWorksheetNamesLinkHideBasedOnCellValue.xlsm]RAHIM'!$A$1
Dim Paf As String: Let Paf = "='" & ThisWorkbook.Path & "\[" & ThisWorkbook.Name & "]" & arrNmes(Cnt - 3, 1) & "'!$A$1" ' "='" & ThisWorkbook.Path & "\[" & ThisWorkbook.Name & "]" & arrNmes(Cnt, 1) & "'!$A$1"
' Ws1.Hyperlinks.Add Anchor:=Ws1.Range("A" & Cnt & ""), Address:="", SubAddress:="='" & arrNmes(Cnt, 1) & "'!A1", ScreenTip:=arrNmes(Cnt, 1), TextToDisplay:=arrNmes(Cnt, 1)
Ws1.Hyperlinks.Add Anchor:=Ws1.Range("C" & Cnt & ""), Address:="", SubAddress:=Paf, ScreenTip:=arrNmes(Cnt - 3, 1), TextToDisplay:=arrNmes(Cnt - 3, 1) ' Ws1.Range("A" & Cnt & ""), Address:="", SubAddress:=Paf, ScreenTip:=arrNmes(Cnt, 1), TextToDisplay:=arrNmes(Cnt, 1)
Next Cnt
Bed: ' error handling code section.
Let Application.EnableEvents = True
End Sub
'



Event macros


'
Private Sub Worksheet_SelectionChange(ByVal Target As Range) ' https://excelfox.com/forum/showthread.php/2501-VBA-for-dynamic-sheets-name-dynamic-link-hide-sheets-based-on-a-cell-Value?p=13456&viewfull=1#post13456
'If Target.Column = 1 And Not IsArray(Target.Value) Then ' we are in column A , And we selected one cell
If Target.Column = 3 And Not IsArray(Target.Value) Then ' we are in column C , And we selected one cell
Set LRng = Target
Else

End If
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
If IsArray(Target.Value) Then Exit Sub ' If we have changed more than 1 cell, our code lines below will error, so best do nothing in such a case
Dim Ws1 As Worksheet
Set Ws1 = Me
Dim Lr1 As Long
Let Lr1 = Ws1.Range("C" & Ws1.Rows.Count & "").End(xlUp).Row ' Range("A" & Ws1.Rows.Count & "").End(xlUp).Row ' http://www.excelfox.com/forum/showthread.php/2345-Appendix-Thread-(-Codes-for-other-Threads-HTML-Tables-etc-)?p=11466&viewfull=1#post11466 Making Lr dynamic ( using rng.End(XlUp) for a single column. )
If Not LRng Is Nothing And Target.Value = "" And LRng.Row = Lr1 + 1 Then Let Lr1 = Lr1 + 1
Dim Rng As Range
Set Rng = Ws1.Range("C4:C" & Lr1 & "") ' Ws1.Range("A1:A" & Lr1 & "")
If Not Intersect(Rng, Target) Is Nothing Then ' The Excel VBA Application.Intersect method returns the range where all the given ranges cross, or Nothing if there are no common cells. So, in this example, we would have Nothing if our selection ( which VBA supplies in Target ) , did not cross our names list ' https://docs.microsoft.com/en-us/office/vba/api/excel.application.intersect
Dim Rw As Long
Let Rw = Target.Row
If Target.Value = "" Or Target.Value = "-" Then ' 5. If I delete the content of A1 (ANUJ), i.e, if cell A1 is blank, the corresponding sheet "ANUJ" should hide automatically.
Let Application.EnableEvents = False
Let Target.Value = ""
Let Application.EnableEvents = True
' ThisWorkbook.Worksheets.Item(Rw + 1).Visible = False
ThisWorkbook.Worksheets.Item(Rw + 1 - 3).Visible = False
Exit Sub
Else
' ThisWorkbook.Worksheets.Item(Rw + 1).Visible = True
' Let ThisWorkbook.Worksheets.Item(Rw + 1).Name = Target.Value ' In the list, each row number corresponds to one less than the item number of our worksheets made from that list
ThisWorkbook.Worksheets.Item(Rw + 1 - 3).Visible = True
Let ThisWorkbook.Worksheets.Item(Rw + 1 - 3).Name = Target.Value
End If
Else
' changed cell was not in Student name list
End If

'
Call AddHypolinkToWorksheet
End Sub



Top 2 lines of code module

Option Explicit
Dim LRng As Range




File:
DynamicWorksheetNamesLinkHideBasedOnCellValueC.xls m : https://app.box.com/s/alo1fbzx8r41jd81rttghikytqzvm0w9

[DocAElstein]

kkfhhfsfhsah

[DocAElstein]

In suppot of this forum post
https://www.excelforum.com/excel-programming-vba-macros/1317589-conditionally-compare-the-data-and-delete-entire-row.html#post5340103



' Alert 29May excelforum..csv https://www.excelforum.com/excel-programming-vba-macros/1317589-conditionally-compare-the-data-and-delete-entire-row.html
'If column J of 1.xls has buy & column H of 1.xls is not greater than column D of 1.xls
' then match column I data of 1.xls with column B of alert.csv and
' if it matches then delete that entire row of alert.csv
'If column J of 1.xls has a blank cell
' then match column I data of 1.xls with column B of alert.csv and
' if it matches then delete that entire row of alert.csv
'If column J of 1.xls has short & column H of 1.xls is Greater than than column D of 1.xls
' then match column I data of 1.xls with column B of alert.csv and
' if it matches then delete that entire row of alert.csv

' With Sheets(1)
' Lr = .Range("a" & Rows.Count).End(xlUp).Row

' Missed 3 dots.
' With GetObject(fn)
' With .Sheets(1)
' Lr = .Range("a" & .Rows.Count).End(xlUp).Row
Sub OpenAlert29Mayexcelforum__csv()
Workbooks.Open Filename:=ThisWorkbook.Path & "\Alert 29May excelforum..csv"
End Sub

Sub JindonsTesties() ' Conditionally compare the data & delete entire row - https://www.excelforum.com/excel-programming-vba-macros/1317589-conditionally-compare-the-data-and-delete-entire-row.html#post5340103
' PART 1 ================================
Dim LR As Long, e ', fn As String ' , myCSV As String, txt As String, vTemp As Variant, arrTemp() As Variant
Rem 1 Workbooks, Worksheets info
' fn = ThisWorkbook.Path & "\1.xls" '"C:\Users\WolfieeeStyle\Desktop\1.xls"
' myCSV = ThisWorkbook.Path & "\Alert 29May excelforum..csv" ' "C:\Users\WolfieeeStyle\Desktop\Alert..csv"
' If (Dir(fn) = "") + (Dir(myCSV) = "") Then MsgBox "Invalid file Path/Name": Exit Sub
Dim Wb1 As Workbook
Set Wb1 = Workbooks("1.xls") ' CHANGE TO SUIT
' Set Wb1 = Workbooks.Open("C:\Users\WolfieeeStyle\Desktop\1.xls") ' CHANGE TO SUIT
'With GetObject(fn)
'With .Worksheets.Item(1)
Dim Ws1 As Worksheet
Set Ws1 = Wb1.Worksheets.Item(1)
Let LR = Ws1.Range("a" & Ws1.Rows.Count).End(xlUp).Row ' 1.xls last row of data
Rem 2 Make 1 Dimensional arrays for values
'2a) If column J of 1.xls has buy & column H of 1.xls is not greater than column D of 1.xls
'Let vTemp = .Evaluate("transpose(if((j2:j" & LR & "=""buy"")*(h2:h" & LR & "<d2:d" & LR & "),i2:i" & LR & "))")
Dim arrTemp() As Variant
Let arrTemp() = Ws1.Evaluate("transpose(if((j2:j" & LR & "=""buy"")*(h2:h" & LR & "<d2:d" & LR & "),i2:i" & LR & "))")
Dim txt As String
For Each e In Filter(arrTemp(), False, 0) ' Filter(arrTemp(), False, 0) is empty
Let txt = txt & " And (Not F2 = " & e & ")"
Next
'2b) If column J of 1.xls has short & column H of 1.xls is Greater than column D of 1.xls
' Let vTemp = .Evaluate("transpose(if((j2:j" & LR & "=""short"")*(h2:h" & LR & ">d2:d" & LR & "),i2:i" & LR & "))")
Let arrTemp() = Ws1.Evaluate("transpose(if((j2:j" & LR & "=""short"")*(h2:h" & LR & ">d2:d" & LR & "),i2:i" & LR & "))")
For Each e In Filter(arrTemp(), False, 0) ' Filter(arrTemp(), False, 0) is {100}
Let txt = txt & " And (Not F2 = " & e & ")"
Next
'2c) If column J of 1.xls has a blank
' Let vTemp = .Evaluate("transpose(if(j2:j" & LR & "="""",i2:i" & LR & "))")
Let arrTemp() = Ws1.Evaluate("transpose(if(j2:j" & LR & "="""",i2:i" & LR & "))")
For Each e In Filter(arrTemp(), False, 0) ' Filter(arrTemp(), False, 0) is {15083, 17388}
Let txt = txt & " And (Not F2 = " & e & ")"
Next
'End With ' final txt is And (Not F2 = 15083) And (Not F2 = 17388) And (Not F2 = 100)
'.Close
'End With
' CreateNew myCSV, Mid$(txt, 5)
' Let txt = Mid$(txt, 6) ' take off the first " AND "

' Part 2 ================================================== =============================
'End Sub
'Sub MyTests_CreateNew()
Rem 3 source text file
'3a) source text file
Dim myCSV As String ' , txt As String
Let myCSV = ThisWorkbook.Path & "\Alert 29May excelforum..csv" ' "C:\Users\WolfieeeStyle\Desktop\Alert..csv"
' Call CreateNew(myCSV, Mid$(txt, 5))
'End Sub
'Private Sub CreateNew(myCSV As String, txt As String)
Dim fn As String ' , cn As Object, rs As Object, x
' 3b Make copy of test file , make temporary file
fn = Left$(myCSV, InStrRev(myCSV, "\")) & "tempComma.csv"
Dim PathAndFileName As String: Let PathAndFileName = fn
FileCopy myCSV, fn ' FileCopy source, destination https://docs.microsoft.com/en-us/office/vba/language/reference/user-interface-help/filecopy-statement

Rem 4 ADODB stuff
'4a)
Dim Cn As Object: Set Cn = CreateObject("ADODB.Connection")
With Cn
.Provider = "Microsoft.Ace.OLEDB.12.0"
.Properties("Extended Properties") = "Text;HDR=No;"
'.Open Left(fn, InStrRev(fn, "\"))
Dim PathOnly As String: Let PathOnly = Left(fn, InStrRev(fn, "\"))
.Open PathOnly
End With
'4b)
Let txt = Mid$(txt, 6) ' (Not F2 = 15083) And (Not F2 = 17388) And (Not F2 = 100)
Dim Rs As Object: Set Rs = CreateObject("ADODB.Recordset")
Rs.Open "Select * From [tempComma.csv] Where " & txt, Cn, 3
Dim x As String
Let x = Rs.GetString(, , ",", vbCrLf): Debug.Print x

Set Cn = Nothing: Set Rs = Nothing
Rem 5
Kill fn
Rem 6
Open Replace(myCSV, ".csv", "_Filtered.csv") For Output As #1
Print #1, x;
Close #1
End Sub

[DocAElstein]

In suppot of this forum post
https://excelfox.com/forum/showthread.php/2518-convert-the-data-from-xlsx-to-txt-file
https://www.excelfox.com/forum/showthread.php/2345-Appendix-Thread-(-Codes-for-other-Threads-HTML-Tables-etc-)/page30#post13348


' https://excelfox.com/forum/showthread.php/2302-quot-What%E2%80%99s-in-a-String-quot-VBA-break-down-Loop-through-character-contents-of-a-string
' https://excelfox.com/forum/showthread.php/2302-quot-What%E2%80%99s-in-a-String-quot-VBA-break-down-Loop-through-character-contents-of-a-string?p=11015&viewfull=1#post11015
Sub WtchaGot_Unic_NotMuchIfYaChoppedItOff(ByVal strIn As String) '
Rem 1 ' Output "sheet hardcopies"
'1a) Worksheets 'Make Temporary Sheets, if not already there, in Current Active Workbook, for a simple list of all characters, and for pasting the string into worksheet cells
'1a)(i) Full list of characters worksheet
If Not Evaluate("=ISREF(" & "'" & "WotchaGotInString" & "'!Z78)") Then ' ( the ' are not important here, but in general allow for a space in the worksheet name like "Wotcha Got In String"
Dim Wb As Workbook ' ' ' Dim: ' Preparing a "Pointer" to an Initial "Blue Print" in Memory of the Object ( Pigeon Hole with a bit of paper or code lines on that can be filled in to refer to a specific Objec of this type ) . This also us to get easily at the Methods and Properties throught the applying of a period ( .Dot) ( intellisense ) '
Set Wb = ActiveWorkbook ' ' Set now (to Active Workbook - one being "looked at"), so that we carefull allways referrence this so as not to go astray through Excel Guessing inplicitly not the one we want... Set: Values are filled at the memory locations and the directions there are specified in the variable "Blue Print "Pointer". In this case a Filled in Blue Print is passed. http://www.excelforum.com/excel-programming-vba-macros/1138804-help-understanding-class-instancing-cant-set-ws-new-worksheet-intellisense-offers-it-4.html#post4387191 '
Wb.Worksheets.Add After:=Wb.Worksheets.Item(Worksheets.Count) 'A sheeet is added and will be Active
Dim Ws As Worksheet '
Set Ws = ActiveSheet 'Rather than rely on always going to the active sheet, we referr to it Explicitly so that we carefull allways referrence this so as not to go astray through Excel Guessing implicitly not the one we want... Set: Values are filled at the memory locations and the directions there are specified in the variable "Blue Print "Pointer". In this case a Filled in Blue Print is passed. http://www.excelforum.com/excel-programming-vba-macros/1138804-help-understanding-class-instancing-cant-set-ws-new-worksheet-intellisense-offers-it-4.html#post4387191 ' Values are filled at the memory locations and the directions there are specified in the variable "Blue Print "Pointer". In this case a Filled in Blue Print is passed. http://www.excelforum.com/excel-programming-vba-macros/1138804-help-understanding-class-instancing-cant-set-ws-new-worksheet-intellisense-offers-it-4.html#post4387191
Ws.Activate: Ws.Cells(1, 1).Activate ' ws.Activate and activating a cell sometimes seemed to overcome a strange error
Let Ws.Name = "WotchaGotInString"
Else ' The worksheet is already there , so I just need to set my variable to point to it
Set Ws = ThisWorkbook.Worksheets("WotchaGotInString")
End If
'1a(ii) Worksheet to paste out string into worksheet cells
If Not Evaluate("=ISREF(" & "'" & "StrIn|WtchaGot" & "'!Z78)") Then
Set Wb = ActiveWorkbook
Wb.Worksheets.Add After:=Wb.Worksheets.Item(1)
Dim Ws1 As Worksheet
Set Ws1 = ActiveSheet
Ws1.Activate: Ws1.Cells(1, 1).Activate
Let Ws1.Name = "StrIn|WtchaGot"
Else
Set Ws1 = ThisWorkbook.Worksheets("StrIn|WtchaGot")
End If
'1b) Array
Dim myLenf As Long: Let myLenf = Len(strIn) ' ' Long is very simple to handle, - final memory "size" type is known (123.456 and 000.001 have same "size" computer memory ) , and so a Address suggestion can be given for the next line when the variable is filled in. '( Long is a Big whole Number limit (-2,147,483,648 to 2,147,483,647) If you need some sort of validation the value should only be within the range of a Byte/Integer otherwise there's no point using anything but Long.--upon/after 32-bit, Integers (Short) need converted internally anyways, so a Long is actually faster. ) https://www.mrexcel.com/forum/excel-questions/803662-byte-backward-loop-4.html
Dim arrWotchaGot() As String: ReDim arrWotchaGot(1 To myLenf + 1, 1 To 2) ' +1 for header Array for the output 2 column list. The type is known and the size, but I must use this ReDim method simply because the dim statement Dim( , ) is complie time thing and will only take actual numbers
Let arrWotchaGot(1, 1) = Format(Now, "DD MMM YYYY") & vbLf & "Lenf is " & myLenf: Let arrWotchaGot(1, 2) = Left(strIn, 40)
Rem 2 String anylaysis
'Dim myLenf As Long: Let myLenf = Len(strIn)
Dim Cnt As Long
For Cnt = 1 To myLenf ' ===Main Loop============================================== ==========================
' Character analysis: Get at each character
Dim Caracter As Variant ' String is probably OK.
Let Caracter = Mid(strIn, Cnt, 1) ' ' the character in strIn at position from the left of length 1
'2a) The character added to a single WotchaGot long character string to look at and possibly use in coding
Dim WotchaGot As String ' This will be used to make a string that I can easilly see and also is in a form that I can copy and paste in a code line required to build the full string of the complete character string
'2a)(i) Most common characters and numbers to be displayed as "seen normally" ' -------2a)(i)--
If Caracter Like "[A-Z]" Or Caracter Like "[0-9]" Or Caracter Like "[a-z]" Then ' Check for normal characters
'SirNirios
If Not Cnt = 1 Then ' I am only intersted in next line comparing the character before, and if i did not do this the next line would error if first character was a "normal" character
If Not Cnt = myLenf And (Mid(strIn, Cnt - 1, 1) Like "[A-Z]" Or Mid(strIn, Cnt - 1, 1) Like "[0-9]" Or Mid(strIn, Cnt - 1, 1) Like "[a-z]") Then ' And (Mid(strIn, Cnt + 1, 1) Like "[A-Z]" Or Mid(strIn, Cnt + 1, 1) Like "[0-9]" Or Mid(strIn, Cnt + 1, 1) Like "[a-z]") Then
Let WotchaGot = WotchaGot & "|LinkTwoNormals|"
Else
End If
Else
End If
Let WotchaGot = WotchaGot & """" & Caracter & """" & " & " ' This will give the sort of output that I need to write in a code line, so for example if I have a123 , this code line will be used 4 times and give like a final string for me to copy of "a" & "1" & "2" & "3" & I would phsically need to write in code like strVar = "a" & "1" & "2" & "3" - i could of course also write = "a123" but the point of this routine is to help me pick out each individual element
Else ' Some other things that I would like to "see" normally - not "normal simple character" - or by a VBA constant, like vbCr vbLf vbTab
Select Case Caracter ' 2a)(ii)_1
Case " "
Let WotchaGot = WotchaGot & """" & " " & """" & " & "
Case "!"
Let WotchaGot = WotchaGot & """" & "!" & """" & " & "
Case "$"
Let WotchaGot = WotchaGot & """" & "$" & """" & " & "
Case "%"
Let WotchaGot = WotchaGot & """" & "%" & """" & " & "
Case "~"
Let WotchaGot = WotchaGot & """" & "~" & """" & " & "
Case "&"
Let WotchaGot = WotchaGot & """" & "&" & """" & " & "
Case "("
Let WotchaGot = WotchaGot & """" & "(" & """" & " & "
Case ")"
Let WotchaGot = WotchaGot & """" & ")" & """" & " & "
Case "/"
Let WotchaGot = WotchaGot & """" & "/" & """" & " & "
Case "\"
Let WotchaGot = WotchaGot & """" & "\" & """" & " & "
Case "="
Let WotchaGot = WotchaGot & """" & "=" & """" & " & "
Case "?"
Let WotchaGot = WotchaGot & """" & "?" & """" & " & "
Case "'"
Let WotchaGot = WotchaGot & """" & "'" & """" & " & "
Case "+"
Let WotchaGot = WotchaGot & """" & "+" & """" & " & "
Case "-"
Let WotchaGot = WotchaGot & """" & "-" & """" & " & "
Case "_"
Let WotchaGot = WotchaGot & """" & "_" & """" & " & "
Case "."
Let WotchaGot = WotchaGot & """" & "." & """" & " & "
Case ","
Let WotchaGot = WotchaGot & """" & "," & """" & " & "
Case ";"
Let WotchaGot = WotchaGot & """" & ";" & """" & " & "
Case ":"
Let WotchaGot = WotchaGot & """" & ":" & """" & " & "
' Case " "
' Let WotchaGot = WotchaGot & """" & " " & """" & " & "
' Case " "
' Let WotchaGot = WotchaGot & """" & " " & """" & " & "
' Case " "
' Let WotchaGot = WotchaGot & """" & " " & """" & " & "
' Case " "
' Let WotchaGot = WotchaGot & """" & " " & """" & " & "
' Case " "
' Let WotchaGot = WotchaGot & """" & " " & """" & " & "
' Case " "
' Let WotchaGot = WotchaGot & """" & " " & """" & " & "
' Case " "
' Let WotchaGot = WotchaGot & """" & " " & """" & " & "
' Case " "
' Let WotchaGot = WotchaGot & """" & " " & """" & " & "
' Case " "
' Let WotchaGot = WotchaGot & """" & " " & """" & " & "
' Case " "
' Let WotchaGot = WotchaGot & """" & " " & """" & " & "
' Case " "
' Let WotchaGot = WotchaGot & """" & " " & """" & " & "
' Case " "
' Let WotchaGot = WotchaGot & """" & " " & """" & " & "
' ' 2a)(ii)_2
' Case " "
' Let WotchaGot = WotchaGot & """" & " " & """" & " & "
' Case " "
' Let WotchaGot = WotchaGot & """" & " " & """" & " & "
Case vbCr
Let WotchaGot = WotchaGot & "vbCr & " ' I actuall would write manually in this case like vbCr &
Case vbLf
Let WotchaGot = WotchaGot & "vbLf & "
Case vbCrLf
Let WotchaGot = WotchaGot & "vbCrLf & "
Case vbNewLine
Let WotchaGot = WotchaGot & "vbNewLine & "
Case """" ' This is how to get a single " No one is quite sure how this works. My theory that, is as good as any other, is that syntaxly """" or " """ or """ " are accepted. But in that the """ bit is somewhat strange for VBA. It seems to match the first and Third " together as a valid pair but the other " in the middle of the 3 "s is also syntax OK, and does not error as """ would because of the final 4th " which it syntaxly sees as a valid pair matched simultaneously as it does some similar check on the first and Third as a concluding string pair. All is well except that the second " is captured within a accepted enclosing pair made up of the first and third " At the same time the 4th " is accepted as a final concluding " paired with the second which it is using but at the same time now isolated from.
Let WotchaGot = WotchaGot & """" & """" & """" & """" & " & " ' The reason why "" "" would not work is that at the end of the "" the next empty character signalises the end of a string pair, and only if it saw a " would it keep checking the syntax rules which then lead in the previous case to the situation described above.
Case vbTab
Let WotchaGot = WotchaGot & "vbTab & "
' 2a)(iii)
Case Else
If AscW(Caracter) < 256 Then
Let WotchaGot = WotchaGot & "Chr(" & AscW(Caracter) & ")" & " & "
Else
Let WotchaGot = WotchaGot & "ChrW(" & AscW(Caracter) & ")" & " & "
End If
'Let CaseElse = Caracter
End Select
End If ' End of the "normal simple character" or not ' -------2a)------Ended-----------
'2b) A 2 column Array for convenience of a list
Let arrWotchaGot(Cnt + 1, 1) = Cnt & " " & Caracter: Let arrWotchaGot(Cnt + 1, 2) = AscW(Caracter) ' +1 for header
Next Cnt ' ========Main Loop============================================== ===================================
'2c) Some tidying up
If WotchaGot <> "" Then
Let WotchaGot = Left(WotchaGot, Len(WotchaGot) - 3) ' take off last " & " ( 2 spaces one either side of a & )
Let WotchaGot = Replace(WotchaGot, """ & |LinkTwoNormals|""", "", 1, -1, vbBinaryCompare)
' The next bit changes like this "Lapto" & "p" to "Laptop" You might want to leave it out ti speed things up a bit
If Len(WotchaGot) > 5 And (Mid(WotchaGot, Len(WotchaGot) - 1, 1) Like "[A-Z]" Or Mid(WotchaGot, Len(WotchaGot) - 1, 1) Like "[0-9]" Or Mid(WotchaGot, Len(WotchaGot) - 1, 1) Like "[a-z]") And (Mid(WotchaGot, Len(WotchaGot) - 7, 1) Like "[A-Z]" Or Mid(WotchaGot, Len(WotchaGot) - 7, 1) Like "[0-9]" Or Mid(WotchaGot, Len(WotchaGot) - 7, 1) Like "[a-z]") And Mid(WotchaGot, Len(WotchaGot) - 6, 5) = """" & " & " & """" Then
Let WotchaGot = Left$(WotchaGot, Len(WotchaGot) - 7) & Mid(WotchaGot, Len(WotchaGot) - 1, 2) ' Changes like this "Lapto" & "p" to "Laptop"
Else
End If
Else
End If
Rem 3 Output
'3a) String
'3a)(i)
MsgBox Prompt:=WotchaGot: Debug.Print WotchaGot ' Hit Ctrl+g from the VB Editor to get a copyable version of the entire string
'3a)(ii)
Ws1.Activate: Ws1.Cells.Item(1, 1).Activate
Let Ws1.Range("A1").Value = strIn
Let Ws1.Range("B1").Value = WotchaGot
'3b) List
Dim NxtClm As Long: Let NxtClm = 1 ' In conjunction with next If this prevents the first column beine taken as 0 for an empty worksheet
Ws.Activate: Ws.Cells.Item(1, 1).Activate
If Not Ws.Range("A1").Value = "" Then Let NxtClm = Ws.Cells.Item(1, Columns.Count).End(xlToLeft).Column + 1
Let Ws.Cells.Item(1, NxtClm).Resize(UBound(arrWotchaGot(), 1), UBound(arrWotchaGot(), 2)).Value = arrWotchaGot()
Ws.Cells.Columns.AutoFit
End Sub
'

[DocAElstein]

lKSHFLhlhfl

[DocAElstein]

lKSHFLhlhfl

[DocAElstein]

lKSHFLhlhfl

[DocAElstein]

test ...


test

skjfSKJHFkjhfKJSHFSKJHFskjhf

Different File Types used for simple values
See here ( This post https://excelfox.com/forum/showthread.php/2345-Appendix-Thread-(-Codes-for-other-Threads-HTML-Tables-etc-)/page30#post13349 )
for typical comparisons of text Files, Excel files, and data files
Text File: https://excelfox.com/forum/showthread.php/2345-Appendix-Thread-(-Codes-for-other-Threads-HTML-Tables-etc-)?p=13693&viewfull=1#post13693
Excel File: https://excelfox.com/forum/showthread.php/2345-Appendix-Thread-(-Codes-for-other-Threads-HTML-Tables-etc-)?p=13694&viewfull=1#post13694
Data File: https://excelfox.com/forum/showthread.php/2345-Appendix-Thread-(-Codes-for-other-Threads-HTML-Tables-etc-)?p=13695&viewfull=1#post13695


Function to make an Excel files from a text file containing values and separators

XLFlNme is the Excel File name wanted for the new File
TxtFlNme is Text File name of an existing text file
valSep is the values separator used in the existing text file##
LineSep is the line separator used in thee existing text file##
Paf it the path to the files. ( I assume they are at the same place for the existing text file and the new Excel File )

The function is almost identical to the macro I did for you here: Code for Text File to Excelhttps://eileenslounge.com/viewtopic.php?p=269105#p269105
The function is here: https://excelfox.com/forum/showthread.php/2345-Appendix-Thread-(-Codes-for-other-Threads-HTML-Tables-etc-)?p=13717&viewfull=1#post13717

It is a function.
So you will need to call it with a test macro such as this:

' https://excelfox.com/forum/showthread.php/2519-Convert-Csv-To-Xlsx
Sub Test_MakeXLFileusingvaluesInTextFile()
Dim Pf As String
Let Pf = ThisWorkbook.Path ' ' CHANGE TO SUIT
'let pf = "C:\Users\WolfieeeStyle\Desktop" ' CHANGE TO SUIT
Call MakeXLFileusingvaluesInTextFile(Pf, "sample2BEFORE..csv", "Test.xlsx", ",", vbCr & vbLf)
End Sub


I tested it using this text file: Share ‘sample2BEFORE..csv’ : https://app.box.com/s/a3o4irgofydb71e3o0c4aaxefg6dw3bi
NSE,101010,6,<,12783,A,,,,,GTT
NSE,22,6,<,12783,A,,,,,GTT
NSE,17388,6,<,12783,A,,,,,GTT

Running the test macro results in an Excel File being made looking like this:

_____ Workbook: Test.xlsx ( Using Excel 2007 32 bit )
Row\ColABCDEFGHIJKL
1NSE1010106<12783AGTT

2NSE226<12783AGTT

3NSE173886<12783AGTT

4
Worksheet: Sheet1

[DocAElstein]

lKSHFLhlhfl

my testies shit




The biggest problem is..
Since a few weeks you have introduced a new problem for yourself which will help to ensure that you fail in everything: You make many cross post an everyone helping you writes there codes slightly differently. So you are getting into a mixed up chaotic mess of different codlings and are beginning to post many wrong files and incorrect or incomplete macros and explanations of what you want.
You are getting into a mixed up mess



The macro you have posted https://excelfox.com/forum/showthread.php/2349-Copy-and-Paste-based-on-comparisons-Match-and-calculations-of-cells-in-two-workbooks?p=14591&viewfull=1#post14591 does the following:
It looks for the data values in column I of Ws1 in column B of Ws2. So the range to be searched is column B in Ws2. The values to be searched for are in column I of Ws1
When a matched value is found we look at the value in column D of Ws2 at the row where the match occurred. Based on whether or not we have “>” in that cell we will add or subtract 1% to the value in E in Ws2 at the row of the data being looked at , the value in variable I
This last bit is not what you want
For example, first we look for 22 (from row I=2) in column B of Ws2. That is found in row 1 of Ws2.
So
R2=WorksheetFunction.Match(.Cells(I, "I"), Ws2., 0)=1
In row 2 of Ws2 in the D column is a < so we take the option of
.Cells(I, "K").Value = Ws2.Cells(I, "E").Value + 0.01 * Ws2.Cells(I, "E").Value
That code line takes the value in column E at row 2 of Ws1 , which is 200 and adds 1% which is 2, giving you 202, which is not what you want.
But you want it to take the value at the row where the match was found in Ws1, which is 1
That will give the output of 100 +1 = 101

The macro does what you asked for:
If column I of 1.xls matches with column B of Alertcodes.xlsx & column D has < this then calculate the 1% of of column E & add that 1% to column E & the result which will come it will be pasted to column K of 1.xls
If column I of 1.xls matches with column B of Alertcodes.xlsx & column D has > this then calculate the 1% of of column E & subtract that 1% to column E & the result which will come it will be pasted to column K of 1.xls

But what you asked for could mean many things and have many different answers. Your explanation was incomplete. You explanation was very bad.

This was error
Ws2.Cells(i, "E").Value - 0.01 * Ws2.Cells(i, "E").Value
This is correction
Ws2.Cells(R2, "E").Value - 0.01 * Ws2.Cells(R2, "E").Value



This is what you want:
Question:
Values in column I of 1.xls are to be looked for, ( Matched ) in column B of AlertCodes.xlsx
At the row in 1.xls where the match is found, the matched row, the following is to be done:
Consider the value in column D of 1.xls at the matched row in 1.xls
& If column D has this, < , then calculate the 1% of column E & add that 1% to column E & the result which will come it will be pasted to column K of 1.xls at the matched row
Or else if
& If column D has this, > , then calculate the 1% of column E & subtract that 1% from column E & the result which will come it will be pasted to column K of 1.xls at the matched row

Solution:
Here https://excelfox.com/forum/showthread.php/2345-Appendix-Thread-(-Codes-for-other-Threads-HTML-Tables-etc-)?p=14594&viewfull=1#post14594

Before:
_____ Workbook: AlertCodes.xlsx ( Using Excel 2007 32 bit )
Row\ColABCDEFGHIJK
1NSE226<100AGTT

2NSE256<200AGTT

3NSE150836<300AGTT
Worksheet: Sheet4 July 13 2020

_____ Workbook: 1.xls ( Using Excel 2007 32 bit )
Row\ColABCDEFGHIJK
1ExchangeSymbolSeries/ExpiryOpenHighLow Prev CloseLTP

2NSEACCEQ12651282.71246.51275.3124722BUY

3NSEADANIENTEQ151.85165.45151.4151.85152.3525BUY

4NSEADANIPORTSEQ348348338.5346.55338.8515083BUY
Worksheet: 1-Sheet1 13July


[color=B]After running macro here https://excelfox.com/forum/showthread.php/2345-Appendix-Thread-(-Codes-for-other-Threads-HTML-Tables-etc-)?p=14594&viewfull=1#post14594

_____ Workbook: 1.xls ( Using Excel 2007 32 bit )
Row\ColABCDEFGHIJK
1ExchangeSymbolSeries/ExpiryOpenHighLow Prev CloseLTP

2NSEACCEQ12651282.71246.51275.3124722BUY101

3NSEADANIENTEQ151.85165.45151.4151.85152.3525BUY20 2

4NSEADANIPORTSEQ348348338.5346.55338.8515083BUY303
Worksheet: 1-Sheet1 13July




Alan

[DocAElstein]

Just testing links to Threads


( This post is https://excelfox.com/forum/showthread.php/2345-Appendix-Thread-(-Codes-for-other-Threads-HTML-Tables-etc-)/page30#post13349 )





Some notes related to these posts

https://excelfox.com/forum/showthread.php/2519-Convert-Csv-To-Xlsx https://excelfox.com/forum/showthread.php/2467-VBA-To-Copy-Rows-From-One-Workbook-To-text-csv-File-Based-On-Count-In-A-Different-Workbook?p=13318&viewfull=1#post13318
http://www.eileenslounge.com/viewtopic.php?f=30&t=34610
http://www.eileenslounge.com/viewtopic.php?f=30&t=34497&p=267706#p267706
http://www.eileenslounge.com/viewtopic.php?p=269104#p269104
http://www.eileenslounge.com/viewtopic.php?f=30&t=34638
https://chandoo.org/forum/threads/fetching-data-from-notepad-to-excel.44312/#post-264364


Later


See here ( This post https://excelfox.com/forum/showthread.php/2345-Appendix-Thread-(-Codes-for-other-Threads-HTML-Tables-etc-)/page30#post13349 )
for typical comparisons of text Files, Excel files, and data files
Text File: https://excelfox.com/forum/showthread.php/2345-Appendix-Thread-(-Codes-for-other-Threads-HTML-Tables-etc-)?p=13693&viewfull=1#post13693
Excel File: https://excelfox.com/forum/showthread.php/2345-Appendix-Thread-(-Codes-for-other-Threads-HTML-Tables-etc-)?p=13694&viewfull=1#post13694
Data File: https://excelfox.com/forum/showthread.php/2345-Appendix-Thread-(-Codes-for-other-Threads-HTML-Tables-etc-)?p=13695&viewfull=1#post13695

[DocAElstein]

In support of this thread answer
https://excelfox.com/forum/showthread.php/2519-Convert-Csv-To-Xlsx


' https://excelfox.com/forum/showthread.php/2519-Convert-Csv-To-Xlsx
'XLFlNme is the Excel File name wanted for the new File
'TxtFlNme is Text File name of an existing text file
'valSep is the values separator used in the existing text file
'LineSep is the line separator used in thee existing text file
'Paf it the path to the files. ( I assume they are at the same place for the existing text file and the new Excel File )

Function MakeXLFileusingvaluesInTextFile(ByVal Paf As String, ByVal TxtFlNme As String, ByVal XLFlNme As String, ByVal valSep As String, ByVal LineSep As String)

Rem 2 Text file info
' 2a) get the text file as a long single string
Dim FileNum As Long: Let FileNum = FreeFile(1) ' https://msdn.microsoft.com/en-us/vba/language-reference-vba/articles/freefile-function
Dim PathAndFileName As String, TotalFile As String
Let PathAndFileName = Paf & Application.PathSeparator & TxtFlNme ' CHANGE TO SUIT From vixer zyxw1234 : http://www.eileenslounge.com/viewtopic.php?f=30&t=34629 DF.txt https://app.box.com/s/gw941dh9v8sqhvzin3lo9rfc67fjsbic
Open PathAndFileName For Binary As #FileNum 'Open Route to data. Binary is a fundemental type data input...
TotalFile = Space(LOF(FileNum)) '....and wot recives it has to be a string of exactly the right length
Get #FileNum, , TotalFile
Close #FileNum
' 2b) Split into wholes line _ splitting the text file into rows by splitting by Line Seperator
Dim arrRws() As String: Let arrRws() = Split(TotalFile, LineSep, -1, vbBinaryCompare)
Dim RwCnt As Long: Let RwCnt = UBound(arrRws()) + 1 ' +1 is nedeed as the Split Function returns indicies 0 1 2 3 4 5 etc...
' 2c) split first line to determine the Field(column) number
Dim arrClms() As String: Let arrClms() = Split(arrRws(0), valSep, -1, vbBinaryCompare)
Dim ClmCnt As Long: Let ClmCnt = UBound(arrClms()) + 1
' 2d) we can now make an array for all the rows, and columns
Dim arrOut() As String: ReDim arrOut(1 To RwCnt, 1 To ClmCnt)

Rem 3 An array is built up by _....
Dim Cnt As Long
For Cnt = 1 To RwCnt ' _.. considering each row of data
'Dim arrClms() As String
Let arrClms() = Split(arrRws(Cnt - 1), ",", -1, vbBinaryCompare) ' ___.. splitting each row into columns by splitting by the comma
Dim Clm As Long '
For Clm = 1 To UBound(arrClms()) + 1
Let arrOut(Cnt, Clm) = arrClms(Clm - 1)
Next Clm
Next Cnt

Rem 4 Finally the array is pasted to a worksheet in a new file
Workbooks.Add
ActiveWorkbook.SaveAs Filename:=Paf & Application.PathSeparator & XLFlNme, FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
Workbooks("" & XLFlNme & "").Worksheets.Item(1).Range("A1").Resize(RwCnt, ClmCnt).Value = arrOut()

End Function

[DocAElstein]

In support of the answer to these forum Thread posts
https://www.excelforum.com/excel-programming-vba-macros/1319768-if-condition-met-then-put-the-remark-between-files.html
https://excelfox.com/forum/showthread.php/2433-vba-Copy-Paste-Conditional-to-put-remark-1-2-3-etc?p=14130&viewfull=1#post14130


' https://www.excelforum.com/excel-programming-vba-macros/1319768-if-condition-met-then-put-the-remark-between-files.html#post5353174
Sub karmapala()
'Dim arr() As Variant
Dim Wb1 As Workbook, Wb2 As Workbook, Sh1 As Worksheet, Sh2 As Worksheet
Set Wb1 = Workbooks("1.xls")
Set Sh1 = Wb1.Worksheets.Item(1) ' Wb1.Sheets("1-Sheet1")
Dim Rng As Range ' For main data range in 1.xls
' Set Rng = Sh1.Range("D2", Sh1.Range("D" & Rows.Count).End(xlUp)) ' This and the next line will error if macro.xlsm is active when the macro is run as Rows.Count will give a much larger number ( 1048576 ) than there are rows in a pre Excel 2007 worksheet ( .
' Set Rng = Sh1.Range(Sh1.Range("D2"), Sh1.Range("D" & Rows.Count).End(xlUp))'
Set Rng = Sh1.Range("D2", Sh1.Range("D" & Sh1.Rows.Count).End(xlUp))
Set Wb2 = Workbooks("macro.xlsm") ' Workbooks("Macro.xlsm")
Set Sh2 = Wb2.Worksheets.Item(1) ' Wb2.Sheets("Sheet1")
Dim X As Long
X = 0
Rem 2 In this section we build an array, arr(), of column I values to be ... match Column I of 1.xls with column B of macro.xlsm
Dim Cel As Range
For Each Cel In Rng
Dim arr() As Variant ' This will become the array of column I values to be ... match Column I of 1.xls with column B of macro.xlsm
If Cel.Value = Cel.Offset(0, 1).Value And Cel.Value <> Cel.Offset(0, 2).Value Then
' If column D of 1.xls is equal to Column E of 1.xls & column D of 1.xls is not equal to column F of 1.xls Then ...
ReDim Preserve arr(X)
arr(X) = Cel.Offset(0, 5) ' This is the column I value for ... match Column I of 1.xls with column B of macro.xlsm
X = X + 1 ' to make the array element for the next entry, should there be one
End If

'If Cel.Value <> Cel.Offset(0, 1) And Cel.Value = Cel.Offset(0, 2) Then
If Cel.Value = Cel.Offset(0, 2) And Cel.Value <> Cel.Offset(0, 1) Then ' ...
ReDim Preserve arr(X)
ReDim Preserve arr(X)
arr(X) = Cel.Offset(0, 5) ' This is the column I value for ... match Column I of 1.xls with column B of macro.xlsm
X = X + 1 ' to make the array element for the next entry, should there be one
End If
Next

If X = 0 Then Exit Sub

Rem 3 In this section we take each of the values in column I of 1.xls meeting the criteria - ... match Column I of 1.xls with column B of macro.xlsm
Dim El
For Each El In arr() ' arr take each value in column I meeting the criteria - and look for the match in a row in column B of macro.xlsm
Dim B As Range ' The matched cell in column B in macro.xlsm
Set B = Sh2.Range("B:B").Find(El, lookat:=xlWhole) ' Look for the matched cell in macro.xlsm
If Not B Is Nothing Then
Dim FirstAddress As String: FirstAddress = B.Address ' The first match address to check when the VBA .Find Methos starts again
Do
If B.Offset(0, 1).Value = "" Then
B.Offset(0, 1).Value = 1 ' row of match has remark 1 in column C
Else
B.End(xlToRight).Offset(0, 1).Value = B.End(xlToRight).Value + 1
End If
Set B = Sh2.Range("B:B").FindNext(B) ' Look for the Next matched cell in macro.xlsm
Loop While B.Address <> FirstAddress ' check when the VBA .Find Methos starts again
End If
Next

End Sub

[DocAElstein]

post to get the URL - for later use

[DocAElstein]

Solution1 fo this Thread
http://www.eileenslounge.com/viewtopic.php?p=270792#p270792


Sub VBAArrayTypeAlternativeToFilterInSegs_Solution1() ' http://www.eileenslounge.com/viewtopic.php?p=270915#p270915 .......... https://eileenslounge.com/viewtopic.php?p=245238#p245238
Rem Make the two row indicie lists ( string of row indicies seperated witha space )
Dim arrK() As Variant: Let arrK() = Worksheets("Main workbook").Range("K1:K" & Worksheets("Main workbook").Range("A" & Rows.Count & "").End(xlUp).Row & "").Value
Dim strSuc As String, strSpit As String
Let strSuc = "7": Let strSpit = "7"
Dim Cnt As Long
For Cnt = 11 To UBound(arrK(), 1)
If arrK(Cnt, 1) = "Positive" Then '/////////
Let strSuc = strSuc & " " & Cnt
Else
Let strSpit = strSpit & " " & Cnt
End If
Next Cnt
'Debug.Print strSuc
Rem Part A) modification (via string manipulation)
Dim TotRws As Long: Let TotRws = (Len(strSuc) - Len(Replace(strSuc, " ", "", 1, -1, vbBinaryCompare))) + 1 ' effectively we are determining the number or spaces between the row indicies, then +1 to give us the number of row indicies
Dim Segs As Long: Let Segs = Int(TotRws / 27) + 1
For Cnt = 34 To ((Segs * 27) + ((Segs - 1) * 7) + 7) - 34 Step 34
Let strSuc = Application.WorksheetFunction.Substitute(strSuc, " ", " 1 1 1 1 1 1 1 ", Cnt - 6) ' https://excelfox.com/forum/showthread.php/2230-Built-in-VBA-methods-and-functions-to-alter-the-contents-of-existing-character-strings
Next Cnt
Debug.Print strSuc
Dim clms() As Variant: Let clms() = Array(1, 4, 6, 26, 27, 28, 29, 30, 31, 32, 33, 34, 35, 36, 37, 38, 39, 40, 41, 42, 43, 44, 45, 46)
Dim strRws() As String: Let strRws() = Split(strSuc, " ", -1, vbBinaryCompare)
Dim Rws() As String: ReDim Rws(1 To UBound(strRws(), 1) + 1, 1 To 1)
For Cnt = 1 To UBound(strRws(), 1) + 1 ': Debug.Print strRws(Cnt - 1)
Let Rws(Cnt, 1) = strRws(Cnt - 1)
Next Cnt
Dim arrOut() As Variant: Let arrOut() = Application.Index(Worksheets("Main workbook").Cells, Rws(), clms())
Let Worksheets("consultant doctor").Range("A7").Resize(UBound(arrOut(), 1), UBound(arrOut(), 2)) = arrOut()
' ================================================== ===
Rem Part B)
' Header
Worksheets("TempSht").Range("A7:X7").Copy
Worksheets("consultant doctor").Range("A7:X7").PasteSpecial Paste:=xlPasteAll ' https://docs.microsoft.com/en-us/office/vba/api/excel.range.pastespecial https://docs.microsoft.com/de-de/office/vba/api/excel.xlpastetype
' All formats in one go for each segmant from the temporary blue print worksheet
Worksheets("TempSht").Range("A8:X41").Copy
Worksheets("consultant doctor").Range("A8:X" & ((Segs * 27) + ((Segs - 1) * 7) + 7) + 1 & "").PasteSpecial Paste:=xlPasteFormats '
' Formulas
Worksheets("TempSht").Range("A35:X41").Copy
For Cnt = 34 To ((Segs * 27) + ((Segs - 1) * 7) + 7) Step 34
Worksheets("consultant doctor").Range("A" & Cnt & "").Offset(1, 0).Resize(7, 24).PasteSpecial Paste:=xlFormulas ' Value = Worksheets("TempSht").Range("A35:X41").Formula
' Worksheets("consultant doctor").Range("A" & Cnt & "").Offset(-26, 0).Resize(7, 24).Sort key1:=Worksheets("consultant doctor").Range("A" & Cnt & "").Offset(-26, 2), Header:=False ' sorting here will clear the clipboard
Next Cnt
' Sorting
For Cnt = 34 To ((Segs * 27) + ((Segs - 1) * 7) + 7) Step 34
Worksheets("consultant doctor").Range("A" & Cnt & "").Offset(-26, 0).Resize(7, 24).Sort key1:=Worksheets("consultant doctor").Range("A" & Cnt & "").Offset(-26, 2), Header:=False
Next Cnt

'With Worksheets("consultant doctor").Range("A7").Resize(UBound(arrOut(), 1), UBound(arrOut(), 2))
'' Let .Value = arrOut()
'.Sort key1:=Worksheets("consultant doctor").Range("C7"), Header:=True
'.Font.Name = "Times New Roman"
'.Font.Size = 13
'.Columns("D:X").NumberFormat = "0.00"
'.EntireColumn.AutoFit
'End With

''Let clms() = Array(1, 4, 6, 26, 27, 28, 29, 30, 31, 32, 33, 34, 35, 36, 37, 38, 39, 40, 41, 42, 43, 44, 45, 46)
' Let strRws() = Split(strSpit, " ", -1, vbBinaryCompare)
' ReDim Rws(1 To UBound(strRws(), 1) + 1, 1 To 1)
' For Cnt = 1 To UBound(strRws(), 1) + 1
' Let Rws(Cnt, 1) = strRws(Cnt - 1)
' Next Cnt
' Let arrOut() = Application.Index(Worksheets("Main workbook").Cells, Rws(), clms())
'With Worksheets("Specialist Doctor").Range("A7").Resize(UBound(arrOut(), 1), UBound(arrOut(), 2))
'Let .Value = arrOut()
''.Sort Key1:=Worksheets("Specialist Doctor").Range("C7"), Header:=True
'.Font.Name = "Times New Roman"
'.Font.Size = 13
'.Columns("D:X").NumberFormat = "0.00"
'.EntireColumn.AutoFit
'End With
End Sub

[DocAElstein]

post to get the URL - for later use

[DocAElstein]

Solution for this post:
https://eileenslounge.com/viewtopic.php?p=271047#p271047
https://eileenslounge.com/viewtopic.php?p=271137#p271137

The main thing is
Sub DropItIn()

The first macro, Sub VBAArrayTypeAlternativeToFilterToSegs_Solution2() , which is the one that you run, is almost identical to the very first unmodified macro, Sub VBAArrayTypeAlternativeToFilter() ' https://eileenslounge.com/viewtopic.php?p=270792#p270792




Sub VBAArrayTypeAlternativeToFilterToSegs_Solution2() ' https://eileenslounge.com/viewtopic.php?p=271047&sid=d23ea475322d2edf06b70bfeaa95726b#p271047
' Main Data worksheet
Dim arrK() As Variant: Let arrK() = Worksheets("Main workbook").Range("K1:K" & Worksheets("Main workbook").Range("A" & Rows.Count & "").End(xlUp).Row & "").Value
' Get row indicies for the two output worksheets
Dim strSuc As String, strSpit As String
Let strSuc = "7": Let strSpit = "7"
Dim Cnt As Long
For Cnt = 11 To UBound(arrK(), 1)
If arrK(Cnt, 1) = "Positive" Then '/////////
Let strSuc = strSuc & " " & Cnt
Else
Let strSpit = strSpit & " " & Cnt
End If
Next Cnt
' First output worksheet
Dim clms() As Variant: Let clms() = Array(1, 4, 6, 26, 27, 28, 29, 30, 31, 32, 33, 34, 35, 36, 37, 38, 39, 40, 41, 42, 43, 44, 45, 46)
Dim strRws() As String: Let strRws() = Split(strSuc, " ", -1, vbBinaryCompare)
Dim Rws() As String: ReDim Rws(1 To UBound(strRws(), 1) + 1, 1 To 1)
For Cnt = 1 To UBound(strRws(), 1) + 1
Let Rws(Cnt, 1) = strRws(Cnt - 1)
Next Cnt
Dim arrOut() As Variant: Let arrOut() = Application.Index(Worksheets("Main workbook").Cells, Rws(), clms())
With Worksheets("consultant doctor").Range("A7").Resize(UBound(arrOut(), 1), UBound(arrOut(), 2))
Let .Value = arrOut()
.Sort Key1:=Worksheets("consultant doctor").Range("C7"), Header:=True
.Font.Name = "Times New Roman"
.Font.Size = 13
.Columns("D:X").NumberFormat = "0.00"
.EntireColumn.AutoFit
.Borders.LineStyle = xlContinuous
End With
' Adding extra rows and stuff for Worksheets("consultant doctor") ================
' Worksheet,data row count, First data row, First break in data, data rows, extra rows to be inserted
Call DropItIn(Worksheets("consultant doctor"), UBound(strRws(), 1) + 1, 8, 34, 27, 7) ' Worksheet,data row count, First data row, First break in data, data rows, extra rows to be inserted
' second output worksheet
'Let clms() = Array(1, 4, 6, 26, 27, 28, 29, 30, 31, 32, 33, 34, 35, 36, 37, 38, 39, 40, 41, 42, 43, 44, 45, 46)
Let strRws() = Split(strSpit, " ", -1, vbBinaryCompare)
ReDim Rws(1 To UBound(strRws(), 1) + 1, 1 To 1)
For Cnt = 1 To UBound(strRws(), 1) + 1
Let Rws(Cnt, 1) = strRws(Cnt - 1)
Next Cnt
Let arrOut() = Application.Index(Worksheets("Main workbook").Cells, Rws(), clms())
With Worksheets("Specialist Doctor").Range("A7").Resize(UBound(arrOut(), 1), UBound(arrOut(), 2))
Let .Value = arrOut()
.Sort Key1:=Worksheets("Specialist Doctor").Range("C7"), Header:=True
.Font.Name = "Times New Roman"
.Font.Size = 13
.Columns("D:X").NumberFormat = "0.00"
.EntireColumn.AutoFit
.Borders.LineStyle = xlContinuous
End With
' Adding extra rows and stuff for Worksheets("Specialist Doctor") ==================
' Worksheet,data row count, First data row, First break in data, data rows, extra rows to be inserted
Call DropItIn(Worksheets("Specialist Doctor"), UBound(strRws(), 1) + 1, 8, 34, 27, 7) ' Worksheet,data row count, First data row, First break in data, data rows, extra rows to be inserted

End Sub

[DocAElstein]

Macros for Solution 3 in this Thread here
https://eileenslounge.com/viewtopic.php?f=30&t=34878
Post
https://eileenslounge.com/viewtopic.php?p=271150#p271150



Sub Solution3_2Workbooks() '
Rem 1 Worksheets info
Dim WbM As Workbook, WbData As Workbook
Set WbM = ThisWorkbook: Set WbData = Workbooks("Example.xlsx")
' Main Data worksheet
Dim arrK() As Variant: Let arrK() = WbData.Worksheets("Main workbook").Range("K1:K" & Worksheets("Main workbook").Range("A" & Rows.Count & "").End(xlUp).Row & "").Value
' Get row indicies for the two output worksheets
Dim strSuc As String, strSpit As String
Let strSuc = "7": Let strSpit = "7"
Dim Cnt As Long
For Cnt = 11 To UBound(arrK(), 1)
If arrK(Cnt, 1) = "Positive" Then '/////////
Let strSuc = strSuc & " " & Cnt
Else
Let strSpit = strSpit & " " & Cnt
End If
Next Cnt
' First output worksheet
Dim clms() As Variant: Let clms() = Array(1, 4, 6, 26, 27, 28, 29, 30, 31, 32, 33, 34, 35, 36, 37, 38, 39, 40, 41, 42, 43, 44, 45, 46)
Dim strRws() As String: Let strRws() = Split(strSuc, " ", -1, vbBinaryCompare)
Dim Rws() As String: ReDim Rws(1 To UBound(strRws(), 1) + 1, 1 To 1)
For Cnt = 1 To UBound(strRws(), 1) + 1
Let Rws(Cnt, 1) = strRws(Cnt - 1)
Next Cnt
Dim arrOut() As Variant: Let arrOut() = Application.Index(Worksheets("Main workbook").Cells, Rws(), clms())
With WbData.Worksheets("consultant doctor").Range("A7").Resize(UBound(arrOut(), 1), UBound(arrOut(), 2))
Let .Value = arrOut()
.Sort Key1:=Worksheets("consultant doctor").Range("C7"), Header:=True
.Font.Name = "Times New Roman"
.Font.Size = 13
.Columns("D:X").NumberFormat = "0.00"
.EntireColumn.AutoFit
.Borders.LineStyle = xlContinuous
End With
' Adding extra rows and stuff for Worksheets("consultant doctor") ================
' Worksheet,data row count, First data row, First break in data, data rows, extra rows to be inserted
Call DropItIn3(WbData.Worksheets("consultant doctor"), UBound(strRws(), 1) + 1, 8, 34, 27, 7) ' Worksheet,data row count, First data row, First break in data, data rows, extra rows to be inserted
' second output worksheet
'Let clms() = Array(1, 4, 6, 26, 27, 28, 29, 30, 31, 32, 33, 34, 35, 36, 37, 38, 39, 40, 41, 42, 43, 44, 45, 46)
Let strRws() = Split(strSpit, " ", -1, vbBinaryCompare)
ReDim Rws(1 To UBound(strRws(), 1) + 1, 1 To 1)
For Cnt = 1 To UBound(strRws(), 1) + 1
Let Rws(Cnt, 1) = strRws(Cnt - 1)
Next Cnt
Let arrOut() = Application.Index(Worksheets("Main workbook").Cells, Rws(), clms())
With WbData.Worksheets("Specialist Doctor").Range("A7").Resize(UBound(arrOut(), 1), UBound(arrOut(), 2))
Let .Value = arrOut()
.Sort Key1:=Worksheets("Specialist Doctor").Range("C7"), Header:=True
.Font.Name = "Times New Roman"
.Font.Size = 13
.Columns("D:X").NumberFormat = "0.00"
.EntireColumn.AutoFit
.Borders.LineStyle = xlContinuous
End With
' Adding extra rows and stuff for Worksheets("Specialist Doctor") ==================
' Worksheet,data row count, First data row, First break in data, data rows, extra rows to be inserted
Call DropItIn3(WbData.Worksheets("Specialist Doctor"), UBound(strRws(), 1) + 1, 8, 34, 27, 7) ' Worksheet,data row count, First data row, First break in data, data rows, extra rows to be inserted

End Sub



' Call ' Worksheet,data row count, First data row, First break in data, data rows, extra rows to be inserted
'Worksheets("consultant doctor"), UBound(strRws(), 1) + 1 , 8 , 34 27, 7
' 88 , 8 , 34 , 27 , 7
Sub DropItIn3(Ws As Worksheet, RwsCnt As Long, SttRw As Long, FstBkRw As Long, DtaRws As Long, ExtRws As Long) ' https://eileenslounge.com/viewtopic.php?p=271047&sid=d23ea475322d2edf06b70bfeaa95726b#p271047
' Header
ThisWorkbook.Worksheets("TempSht").Range("A7:X7").Copy
Ws.Range("A" & SttRw - 1 & ":X" & SttRw - 1 & "").PasteSpecial Paste:=xlPasteFormats ' https://docs.microsoft.com/en-us/office/vba/api/excel.range.pastespecial https://docs.microsoft.com/de-de/office/vba/api/excel.xlpastetype
' Insert extra rows
' Worksheets("TempSht").Range("A35:X41").Copy
Dim Cnt As Long
' For Cnt = FstBkRw To ((((Int(RwsCnt / DtaRws) + 1) * DtaRws) + (((Int(RwsCnt / DtaRws) + 1) - 1) * ExtRws) + (SttRw - 1))) - (DtaRws + ExtRws) Step DtaRws + ExtRws ' This misses the last section
For Cnt = FstBkRw To ((((Int(RwsCnt / DtaRws) + 1) * DtaRws) + (((Int(RwsCnt / DtaRws) + 1) - 1) * ExtRws) + (SttRw - 1))) Step DtaRws + ExtRws
ThisWorkbook.Worksheets("TempSht").Range("A35:X41").Copy
Ws.Range("A" & Cnt & "").Offset(1, 0).Resize(7, 24).Insert shift:=xlShiftDown ' Value = Worksheets("TempSht").Range("A35:X41").Formula
' Worksheets("consultant doctor").Range("A" & Cnt & "").Offset(-26, 0).Resize(7, 24).Sort key1:=Worksheets("consultant doctor").Range("A" & Cnt & "").Offset(-26, 2), Header:=False ' sorting here will clear the clipboard
Next Cnt

End Sub

[DocAElstein]

Notes in support of this Thread
https://excelfox.com/forum/showthread.php/2569-Copy-row-from-one-workbook-to-another-workbook-based-on-conditions-in-two-other-workbooks

_____ Workbook: 1.xls ( Using Excel 2007 32 bit )
Row\ColABCDEFGHI
1ExchangeSymbolSeries/ExpiryOpenHighLow Prev CloseLTP

2NSEADANIENTEQ151.85165.45151.4151.85152.3525

3NSEAMARAJABATEQ662.5665.9642.55662.5643.5100
Worksheet: 1-Sheet1 6July

_____ Workbook: ap.xls ( Using Excel 2007 32 bit )
Row\ColABCDEFGHIJKLMNOPQRSTUVWXYZ
1UserIdAccountIdEntityNameExchg-SegSymbolInstrument NameOption TypeNetBuyValueNetSellValueNetValueNetBuyQtyNetSel lQtyNetQtyBEPSellAvgPriceBuyAvgPriceLastTradedPric eMarkToMarketRealized MarkToMarketUnrealized MarkToMarketEL MarkToMarketTrading SymbolClient ContextSeries/ExpiryStrike Price

2WC5758NSEAMBUJACEMEQ 10781.1010878.3097.205454201.45199.6520197.297.297 .2AMBUJACEM-EQEQ

3WC5758NSEADANIENTEQ 420.60430.509.9022215.25210.30210.359.99.99.9ADANI ENT-EQEQ25

4WC5758NSESIEMENSEQ 2609.302642.5033.20221321.251304.651322.733.233.23 3.2SIEMENS-EQEQ

5WC5758NSERBLBANKEQ 502.10530.3028.2022265.15251.05249.7528.228.228.2R BLBANK-EQEQ

6WC5758NSENATIONALUMEQ 1768.501782.0013.50545433.0032.7532.7513.513.513.5 NATIONALUM-EQEQ

7WC5758NSEMARICOEQ 1688.401713.0024.6066285.50281.40281.924.624.624.6 MARICO-EQEQ

8WC5758NSEAMARAJABATEQ 2429.102405.70-23.4018133.65134.95135-23.4-23.4-23.4APOLLOTYRE-EQEQ100

9WC5758NSEL&TFHEQ 1765.801794.6028.80181899.7098.1098.2528.828.828.8 L&TFH-EQEQ

10WC5758NSEITCEQ 360.90366.105.2022183.05180.45180.855.25.25.2ITC-EQEQ

11WC5758NSEINFRATELEQ 10988.0011180.70192.705454207.05203.48203.8192.719 2.7192.7INFRATEL-EQEQ

12WC5758NSEDLFEQ 93069.0094283.001214.00486486194.00191.50190.31214 12141214DLF-EQEQ
Worksheet: ap-Sheet1 6July

If column I of 1.xls matches with column Z of ap.xls & column K of ap.xls is equals to column L of ap.xls Then
Look column H of 1.xls & if column H of 1.xls is greater than column D of 1.xls then it has to copy the first row of OrderFormat.xlsx & paste it to BasketOrder.xlsx
If column I of 1.xls matches with column Z of ap.xls & column K of ap.xls is equals to column L of ap.xls Then
Look column H of 1.xls & if column H of 1.xls is lower than column D of 1.xls then it has to copy the third row of OrderFormat.xlsx & paste it to BasketOrder.xlsx

_____ Workbook: OrderFormat.xlsx ( Using Excel 2007 32 bit )
Row\ColABCDEFGHIJKLMNOPQRSTU
1NSEEQNANANA00BUYMARKETNACLIMISDAYWC5758NA3NA

2NSEEQNANANA00SELLSL-MCLIMISDAYWC5758NANANA

3NSEEQNANANA00SELLMARKETNACLIMISDAYWC5758NA3NA

4NSEEQNANANA00BUYSL-MCLIMISDAYWC5758NANANA
Worksheet: Sheet1

Given BasketOrder
_____ Workbook: BasketOrder.xlsx Given by Avinash ( Using Excel 2007 32 bit )
Row\Col
A
B
C
D
E
F
G
H
I
J
K
L
M
N
O
P
Q
R
S
T
U

1NSEEQNANANA
0
0BUYMARKETNACLIMISDAYWC5758NA
3NA
Worksheet: Sheet1 6July

For I of 25 in row 2 of 1.xls, we match with column z / row 3 in ap.xls
Column K and column L in ap.xls are both = 2 in row 3 in ap.xls So column K of ap.xls is equals to column L of ap.xls
Column H of row 2 in 1.xls is greater than column D of row 2 of 1.xls , so we copy the first row of of OrderFormat.xlsx & paste it to BasketOrder.xlsx
So I assume / geuss the given workbook, BasketOrder.xlsx is for After

[DocAElstein]

Macro solution for this post:
https://excelfox.com/forum/showthread.php/2569-Copy-row-from-one-workbook-to-another-workbook-based-on-conditions-in-two-other-workbooks


' https://excelfox.com/forum/showthread.php/2569-Copy-row-from-one-workbook-to-another-workbook-based-on-conditions-in-two-other-workbooks
' Copy row from one workbook to another workbook based on conditions in two other workbooks
Sub CopyRowFromWb4ToWb3basedOnConditionsInWb1AndWb2()
Rem 1 worksheets range info
Dim Wb1 As Workbook, Wb2 As Workbook, Wb3 As Workbook, Wb4 As Workbook
Set Wb1 = Workbooks("1.xls")
Set Wb2 = Workbooks("ap.xls")
Set Wb3 = Workbooks("BasketOrder.xlsx")
Set Wb4 = Workbooks("OrderFormat.xlsx")
Dim Ws1 As Worksheet, Ws2 As Worksheet, Ws3 As Worksheet, Ws4 As Worksheet
Set Ws1 = Wb1.Worksheets.Item(1)
Set Ws2 = Wb2.Worksheets.Item(1)
Set Ws3 = Wb3.Worksheets.Item(1)
Set Ws4 = Wb4.Worksheets.Item(1)
Dim Lr1 As Long, Lr2 As Long, Lr3 As Long ', Lr4 As Long
Let Lr1 = Ws1.Range("A" & Ws1.Rows.Count & "").End(xlUp).Row
Let Lr2 = Ws2.Range("D" & Ws2.Rows.Count & "").End(xlUp).Row
Dim Rng1 As Range, Rng2 As Range ', Rng3 As Range, Rng4 As Range
Set Rng1 = Ws1.Range("A1:I" & Lr1 & "")
Set Rng2 = Ws2.Range("A1:Z" & Lr2 & "")
'1b) data ranges for conditions
Dim arr1() As Variant: Let arr1() = Rng1.Value2
Dim arr1I() As Variant: Let arr1I() = Rng1.Columns(9).Value2
Dim arr2() As Variant: Let arr2() = Rng2.Value2
Dim arr2Z() As Variant: Let arr2Z() = Rng2.Columns("Z").Value2
Rem 2 Do it
Dim Cnt
For Cnt = 2 To Lr1 Step 1
If arr1I(Cnt, 1) <> "" Then
Dim MtchRes As Variant
Let MtchRes = Application.Match(arr1I(Cnt, 1), arr2Z(), 0)
If IsError(MtchRes) Then
' column I 1.xls value is not in column Z of ap.xls
Else ' column I of 1.xls matches with column Z of ap.xls
' if column K of ap.xls is equals to column L of ap.xls
If arr2(MtchRes, 11) = arr2(MtchRes, 12) Then
' If column H of 1.xls is greater than column D of 1.xls then
If arr1(Cnt, 8) > arr1(Cnt, 4) Then
'copy the first row of OrderFormat.xlsx & paste it to BasketOrder.xlsx
Let Ws3.Range("A1:U1").Value2 = Ws4.Range("A1:U1").Value2
ElseIf arr1(Cnt, 8) < arr1(Cnt, 4) Then ' If column H of 1.xls is less than column D of 1.xls then
'copy the third row of OrderFormat.xlsx & pate it to BasketOrder.xlsx
Else
Let Ws3.Range("A1:U1").Value2 = Ws4.Range("A3:U3").Value2
End If
Else
' column K of ap.xls is not equal to column L of ap.xls
End If
End If
Else
' empty column I in 1.xls
End If
Next Cnt
End Sub

[fixer]

This was the Macro

Sub STEP3()
Dim Wb1 As Workbook, Wb2 As Workbook
Set Wb1 = Workbooks.Open("C:\Users\WolfieeeStyle\Desktop\1.xls")
Set Wb2 = Workbooks.Open("C:\Users\WolfieeeStyle\Desktop\Hot Stocks\H2.xlsb")
Dim Ws1 As Worksheet, Ws2 As Worksheet
Set Ws1 = Wb1.Worksheets.Item(1)
Set Ws2 = Wb2.Worksheets.Item(2)
Dim Lr1 As Long, Lr2 As Long:
Let Lr1 = Ws1.Range("A" & Ws1.Rows.Count & "").End(xlUp).Row
Let Lr2 = Ws1.Range("A" & Ws1.Rows.Count & "").End(xlUp).Row
Dim rngSrch As Range: Set rngSrch = Ws2.Range("A2:A" & 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

Else
rngDta.Rows(Cnt).EntireRow.Delete Shift:=xlUp
End If

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


I changed this Macro As per my needs but getting error
So Plz have a look Sir

Sub STEP6()
Dim Wb1 As Workbook, Wb2 As Workbook
Set Wb1 = Workbooks.Open("C:\Users\WolfieeeStyle\Desktop\1.xls")
Set Wb2 = Workbooks.Open("C:\Users\WolfieeeStyle\Desktop\Hot Stocks\H2.xlsb")
Dim Ws1 As Worksheet, Ws2 As Worksheet
Set Ws1 = Wb1.Worksheets.Item(1)
Set Ws2 = Wb2.Worksheets.Item(2)
Dim Lr1 As Long, Lr2 As Long:
Let Lr1 = Ws1.Range("A" & Ws1.Rows.Count & "").End(xlUp).Row
Let Lr2 = Ws1.Range("A" & Ws1.Rows.Count & "").End(xlUp).Row
Dim rngSrch As Range: Set rngSrch = Ws2.Range("A2:A" & 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 else statement in both the macros

Error which i got, I uploaded the pic of the same




https://eileenslounge.com/viewtopic.php?f=30&t=34937&p=271392#p271392



Plz run the macro the file which i have uploaded

[DocAElstein]

Test post for later use, to get url now

[DocAElstein]

In Avinash’s world are two types of files. Only two types , Text files and Excel files. There are no other types of file. There will probably never be any other types of files.


All Files , text files, excel files and all other file types , are held in a computer as just a long string of Text. Even an Excel File is just a long piece of text inside a computer. But it is hard to understand. The software that is Excel decodes the long text and tries to make it appear in values and formats that we can see in a worksheet




Excel Files ( Excel Worksheet spreadsheet )
.xls .xlsm .xlsx .xlsb
An Excel file is very complicated. It can have values and lots of cell formatting.
Because of all cell formatting, it can be very slow in working. Excel is not an efficient thing to use if you only have values

We can open an Excel File manually, using Excel or Notepad
ExcelFileOpenInNotepad.JPG : https://imgur.com/bdym9Lc ExcelFileOpenInExcel.JPG : https://imgur.com/gwOtksS
32983296
In Excel it may looks like this
ExcelFile.JPG : https://imgur.com/8xaZihR
3297
_____ Workbook: ExcelFile.xlsx ( Using Excel 2007 32 bit )
Row\ColABC
1AB

2CD

3
Worksheet: Sheet1

In Notepad it looks like this:
ExcelFileInNotepad.JPG : https://imgur.com/wHTPbO6
3295

PK ! U6»+w ( Ø [Content_Types].xml ¢Ô ( ÌTËNÃ0 ¼#ñ ‘¯(q[ B¨i <ŽP ø co «ŽmyÝÒþ=›¤* Ѩ¥=pI %;3žÌp¼¬L²€€ÚÙœõ³ KÀJ§´æìíõ1½a Fa•0ÎBÎV€l<:? ¾®<`BÓ sVÆèo9GYB%0s ,½)\¨D¤Ç0å^È™˜ -ôz×\: ÁÆ4Ö l4|& A+H&"Ä'Q _ Úk?#<–ܵƒ5w΄÷FK I9_Xõƒ5uE¡%('ç qe ØEÂw b\ À£©Ð
K€X™¬ Ý0ßC!æ&& Kr 5=€ÁÃŽ¶63£ÉæøXj
ÝÞu{òáÂìݹ٩]©ÝÉ*¡íF÷Ž Ôü•È›ÛÕ‰…lñ»tPŠ&Áy䔹£ù¡^½ •z‚„ 5lw•§ƒ£5|è^ Ð ¹ýn½‹Ë¢ãøvø›¬XŠ ê% jË“×ÆWì½²)]€Ã ²é’zú—Dò¦çGŸ ÿÿ PK ! µU0#õ L
Î _rels/.rels ¢Ê (
That text above of a simple Excel File is very complicated because it has all the information needed by Excel to make all the cells and formatting

Making an Excel File with Excel VBA
We can make that Excel File using Excel VBA

Sub MakeExcelFile()
Dim Wb As Workbook, Ws As Worksheet
Workbooks.Add
Set Wb = ActiveWorkbook
Set Ws = Wb.Worksheets.Item(1)
Let Ws.Range("A1") = "A": Let Ws.Range("B1") = "B"
Let Ws.Range("A2") = "C": Let Ws.Range("B2") = "D"
Wb.SaveAs Filename:=ThisWorkbook.Path & "\ExcelFile.xlsx"
End Sub


We usually open Excel files with Excel. So that is why the files with the extensions of .xls .xlsm .xlsx .xlsb are called Excel Files. Such files were designed to be opened in Excel

If we are using an Excel file to store simple data values, then the values are usually divided up so that when opened in Excel the data is shown in cells in rows and columns



Text Files
.csv .txt
Text files are very simple. They only have values and sometimes , if it is being used to store data values, it may have separators**. ( Sometimes we call the seperators delimiters ).

A B
C D

A,B
C,D

We usually open text files with a text editor. For example Notepad.
TextFileOpenInNotepad.JPG : https://imgur.com/zzRAVIN
3299
Because Text files are not complicated, we can see them easily in Notepad. Because we sometimes open files with the extension of .csv .txt in Notepad , they may be called Notepad files, and sometimes files with the extension of .csv may be called a comma separated values text values file or “csv file”. But really they are both Text files

**If we want to store simple data values in a text file, then we have the problem that we have no way to make the data appear in cells, because a text file has no cell information and also no other formatting information.
So we typically separate data on a line with something like, _ ; , vbTab | _ etc…
A Line is separated from the next line by an “invisible” character which tells a computer to make a new line, for example
vbCr & vbLf

Make a Text file using Excel VBA
We can make a text file using Excel VBA

Sub MakeTextFile()
Dim FileNum As Long: Let FileNum = FreeFile(1) ' https://msdn.microsoft.com/en-us/vba/language-reference-vba/articles/freefile-function
Open ThisWorkbook.Path & "\" & "TextFile.txt" For Output As #FileNum ' Will be made if not there
Print #FileNum, "A" & vbTab & "B" & vbCr & vbLf & "C" & vbTab & "D"
Close #FileNum
End Sub

We can try to .Open a text file in Excel. Excel will try to show us the values from it in cells. It may work. It may not work. There will always be problems.
But we may want to see the values in Excel
Because there are always problems .Opening a text file in Excel, we import the values into an Excel worksheet instead
The text file made in that last macro , TextFile.txt , can be seen in Notepad to look like this:
TextFile_txtInNotepad.JPG : https://imgur.com/0B2BQpK

A B
C D
( We can represent that file as a simple string in VBA coding, thus:
"A" & vbTab & "B" & vbCr & vbLf & "C" & vbTab & "D"
( We might sometimes call this a Tab separated values or Tab delimited values text file ) )
The following macro is the best way to put the values from that text file into a worksheet. This may typically be called importing a text file into Excel. It does not convert a text file to an Excel File.

Sub ImportTextFileValuesIntoExcelWorksheet()
Rem 1 Add a workbook to display the values from a Tab delimited values text file
Dim Wb As Workbook, Ws As Worksheet
Workbooks.Add
Set Wb = ActiveWorkbook
Set Ws = Wb.Worksheets.Item(1)

Rem 2 Put the entire text file into a single string, TotalFile
Dim FileNum As Long: Let FileNum = FreeFile(1) ' https://msdn.microsoft.com/en-us/vba/language-reference-vba/articles/freefile-function
Dim PathAndFileName As String, TotalFile As String
Let PathAndFileName = ThisWorkbook.Path & "\" & "TextFile.txt" '
Open PathAndFileName For Binary As #FileNum ' Open Route to data. Binary is a fundemental type data input...
TotalFile = Space(LOF(FileNum)) '....and wot recives it hs to be a string of exactly the right length
Get #FileNum, , TotalFile
Close #FileNum ' I need to do this, or there may be problems with my computer as I have an open route which may interact badly with something else

If Right(TotalFile, 2) = vbCr & vbLf Then Let TotalFile = Left(TotalFile, Len(TotalFile) - 2) ' Sometimes an extra line seperator gets added, so I remove it if that is the case

Rem 3 Loop through the lines of the text file and paste each line to a row in the worksheet
Dim Rws() As String ' I want to get an array of all my rows
Let Rws() = Split(TotalFile, vbCr & vbLf, -1, vbBinaryCompare) ' I Split by the row seperator which is usualy vbCr & vbLf but note that it might sometimes be something else
Dim Cnt As Long ' I wat to loop for all the lines in the text file
For Cnt = 1 To UBound(Rws()) + 1 ' I need to use +1 because the one dimensional array returned by Split starts at 0
Dim Clms() As String ' I want an array of just the values. I can easily achieve this by spliting by the value seperator
Let Clms() = Split(Rws(Cnt - 1), vbTab, -1, vbBinaryCompare) ' I now split the row into columns using the value seperator, which in this case is vbTab
Let Ws.Range("A" & Cnt & "").Resize(1, UBound(Clms()) + 1).Value = Clms() ' I can assign my 1 dimensional array to a worksheet range, and Excel will accept it conventionally as a row of data
Next Cnt
End Sub

It is better to use text files and manipulate text files with Excel VBA if we are only looking at values



VBA Arrays
It is better to use text files and manipulate text files with Excel VBA if we are only looking at values.
Excel is very slow and inefficient if we are only looking at values
But we can make Macros for Excel using Excel VBA a little better if we use VBA arrays.
Instead of putting values in an Excel worksheet, one value at a time, we can put all values into an array, and then at the end of the macro we can put all the values into the worksheet in one go. This makes the macro quicker

Sub MakeExcelFileUsingVBAArrays()
Dim Wb As Workbook, Ws As Worksheet
Workbooks.Add
Set Wb = ActiveWorkbook
Set Ws = Wb.Worksheets.Item(1)
' Make array
Dim arr1(1 To 2, 1 To 2) As String
Let arr1(1, 1) = "A": Let arr1(1, 2) = "B"
Let arr1(2, 1) = "C": Let arr1(2, 2) = "D"
' Paste entire array into worksheet in one go
Let Ws.Range("A1:B2").Value = arr1()

Wb.SaveAs Filename:=ThisWorkbook.Path & "\ExcelFileMadeUsingVBAArrays.xlsx"
End Sub

The array, arr1() , can be considered to look like this:



1
2


1
A
B


2
C
D

But we cannot easily see this array, as it is just inside the computer in memory. But we can paste the array into a worksheet in one go using a code line like:
Let1 Ws.Range("A1:B2").Value = arr1()



For Avinash it is better to use as much manipulation of text files using VBA and VBA arrays as possible

You must not learn any VBA coding if you do not want to.
But you must try to understand the difference in text files and excel files
If you cannot or will not learn this, then there is no point in anyone trying to help you further. You will get nowhere. You will waste everybody’s time, including your own

[DocAElstein]

posting to get the URL for later use

[DocAElstein]

Next macro version to answer this Thread Post:
https://excelfox.com/forum/showthread.php/2364-Delete-rows-based-on-match-criteria-in-two-excel-files?p=14635&viewfull=1#post14635



Sub STEP3b() ' https://excelfox.com/forum/showthread.php/2364-Delete-rows-based-on-match-criteria-in-two-excel-files?p=14587&viewfull=1#post14587 https://eileenslounge.com/viewtopic.php?f=30&t=34937
Dim Wb1 As Workbook, Wb2 As Workbook
Set Wb1 = Workbooks.Open(ThisWorkbook.Path & "\1(sample).xls") ' Workbooks.Open("C:\Users\WolfieeeStyle\Desktop\1.xls")
Set Wb2 = Workbooks.Open(ThisWorkbook.Path & "\H2(SAMPLE).xlsx") ' Workbooks.Open("C:\Users\WolfieeeStyle\Desktop\Hot Stocks\H2.xlsb")
Dim Ws1 As Worksheet, Ws2 As Worksheet
Set Ws1 = Wb1.Worksheets.Item(1) ' First worksheet tab counting from the left
Set Ws2 = Wb2.Worksheets.Item(2) ' Second worksheet tab cunting from the left
Dim Lr1 As Long, Lr2 As Long
Let Lr1 = Ws1.Range("A" & Ws1.Rows.Count & "").End(xlUp).Row ' Dynamically getting the last row in worksheet referenced by Ws1
Let Lr2 = Ws2.Range("A" & Ws2.Rows.Count & "").End(xlUp).Row ' Dynamically getting the last row in worksheet referenced by Ws2
Dim rngSrch As Range: Set rngSrch = Ws2.Range("A2:A" & Lr2 & "") ' The range that will be searched in
Dim rngDta As Range: Set rngDta = Ws1.Range("B1:B" & Lr1 & "") ' The range from which data will be looked for in rngSrch

Dim Cnt As Long ' For each rngDta.Item(Cnt)
For Cnt = Lr1 To 2 Step -1 ' We take -ve steps = we go backwards. This is important when deleteing things. See: https://excelfox.com/forum/showthread.php/2345-Appendix-Thread-(-Codes-for-other-Threads-HTML-Tables-etc-)?p=12902&viewfull=1#post12902
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 ' Range.Find would return nothing if it did not find a match
' If it was Not Nothing then there was a match. So we do nothing
Else ' The attempt at a match failed, we got Nothing this is the condition to delete
rngDta.Rows(Cnt).EntireRow.Delete Shift:=xlUp ' The row is deleted , and so we have a space which is filled by shifting all rows in the worksheet Up
End If

Next Cnt ' Next rngDta.Item(Cnt)
Wb1.Close SaveChanges:=True ' Save the file and close it
Wb2.Close SaveChanges:=True ' Save the file and close it
End Sub





So finally what this macro is doing. In English:
Data values in Ws1 , (first worksheet in "1(sample).xls") column B , are looked for ( attempted to be matched ) to the column A range in Ws2 ( second worksheet in "H2(SAMPLE).xlsx")
If a match is found, then nothing is done. If a match was not found, then the entire row containing the data value in Ws1 is deleted

[DocAElstein]

Macros for this Post
https://excelfox.com/forum/showthread.php/2364-Delete-rows-based-on-match-criteria-in-two-excel-files?p=14639&viewfull=1#post14639


Data values in Ws1 , (first worksheet in "1(sample).xls") column B , are looked for ( attempted to be matched ) to the column A range in Ws2 ( second worksheet in "H2(SAMPLE).xlsx")
If a match is not found, then nothing is done. If a match is found, then the entire row containing the data value in Ws1 is deleted



Sub STEP3c() ' https://excelfox.com/forum/showthread.php/2364-Delete-rows-based-on-match-criteria-in-two-excel-files?p=14639&viewfull=1#post14639
Dim Wb1 As Workbook, Wb2 As Workbook
Set Wb1 = Workbooks.Open(ThisWorkbook.Path & "\1(sample).xls") ' Workbooks.Open("C:\Users\WolfieeeStyle\Desktop\1.xls")
Set Wb2 = Workbooks.Open(ThisWorkbook.Path & "\H2SAMPLE.xlsx") ' Workbooks.Open("C:\Users\WolfieeeStyle\Desktop\Hot Stocks\H2.xlsb")
Dim Ws1 As Worksheet, Ws2 As Worksheet
Set Ws1 = Wb1.Worksheets.Item(1) ' First worksheet tab counting from the left
Set Ws2 = Wb2.Worksheets.Item(2) ' Second worksheet tab counting from the left
Dim Lr1 As Long, Lr2 As Long
Let Lr1 = Ws1.Range("B" & Ws1.Rows.Count & "").End(xlUp).Row ' Dynamically getting the last row in worksheet referenced by Ws1
Let Lr2 = Ws2.Range("A" & Ws2.Rows.Count & "").End(xlUp).Row ' Dynamically getting the last row in worksheet referenced by Ws2
Dim rngSrch As Range: Set rngSrch = Ws2.Range("A1:A" & Lr2 & "") ' The range that will be searched in
Dim rngDta As Range: Set rngDta = Ws1.Range("B1:B" & Lr1 & "") ' The range from which data will be looked for in rngSrch

Dim Cnt As Long ' For each rngDta.Item(Cnt)
For Cnt = Lr1 To 2 Step -1 ' We take -ve steps = we go backwards. This is important when deleteing things. See: https://excelfox.com/forum/showthread.php/2345-Appendix-Thread-(-Codes-for-other-Threads-HTML-Tables-etc-)?p=12902&viewfull=1#post12902
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 ' Range.Find would return nothing if it did not find a match. Not Nothing is the condituion of a match, the condition to delete the row
rngDta.Rows(Cnt).EntireRow.Delete Shift:=xlUp ' The row is deleted , and so we have a space which is filled by shifting all rows in the worksheet Up
Else ' The attempt at a match failed, we got Nothing this is the condition to do nothing
' If it was Nothing then there was not a match. So we do nothing
End If
Next Cnt ' Next rngDta.Item(Cnt)
Wb1.Close SaveChanges:=True ' Save the file and close it
Wb2.Close SaveChanges:=True ' Save the file and close it
End Sub


Or



Sub STEP3d() ' https://excelfox.com/forum/showthread.php/2364-Delete-rows-based-on-match-criteria-in-two-excel-files?p=14639&viewfull=1#post14639 https://excelfox.com/forum/showthread.php/2364-Delete-rows-based-on-match-criteria-in-two-excel-files?p=14639&viewfull=1#post14639
Dim Wb1 As Workbook, Wb2 As Workbook
Set Wb1 = Workbooks.Open(ThisWorkbook.Path & "\1(sample).xls") ' Workbooks.Open("C:\Users\WolfieeeStyle\Desktop\1.xls")
Set Wb2 = Workbooks.Open(ThisWorkbook.Path & "\H2SAMPLE.xlsx") ' Workbooks.Open("C:\Users\WolfieeeStyle\Desktop\Hot Stocks\H2.xlsb")
Dim Ws1 As Worksheet, Ws2 As Worksheet
Set Ws1 = Wb1.Worksheets.Item(1) ' First worksheet tab counting from the left
Set Ws2 = Wb2.Worksheets.Item(2) ' Second worksheet tab cunting from the left
Dim Lr1 As Long, Lr2 As Long
Let Lr1 = Ws1.Range("B" & Ws1.Rows.Count & "").End(xlUp).Row ' Dynamically getting the last row in worksheet referenced by Ws1
Let Lr2 = Ws2.Range("A" & Ws2.Rows.Count & "").End(xlUp).Row ' Dynamically getting the last row in worksheet referenced by Ws2
Dim rngSrch As Range: Set rngSrch = Ws2.Range("A1:A" & Lr2 & "") ' The range that will be searched in
Dim rngDta As Range: Set rngDta = Ws1.Range("B1:B" & Lr1 & "") ' The range from which data will be looked for in rngSrch

Dim Cnt As Long ' For each rngDta.Item(Cnt)
For Cnt = Lr1 To 2 Step -1 ' We take -ve steps = we go backwards. This is important when deleteing things. See: https://excelfox.com/forum/showthread.php/2345-Appendix-Thread-(-Codes-for-other-Threads-HTML-Tables-etc-)?p=12902&viewfull=1#post12902
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 MtchedCel Is Nothing Then ' Range.Find would return nothing if it did not find a match. Nothing is the condituion of no match, the condition to do nothing
' If a match is not found, then nothing is done
Else ' The attempt at a match was succesful, we got a match, the condition to delete the row
rngDta.Rows(Cnt).EntireRow.Delete Shift:=xlUp ' The row is deleted , and so we have a space which is filled by shifting all rows in the worksheet Up
End If
Next Cnt ' Next rngDta.Item(Cnt)
Wb1.Close SaveChanges:=True ' Save the file and close it
Wb2.Close SaveChanges:=True ' Save the file and close it
End Sub

[DocAElstein]

Macro solution for Problem 2 ( Problem2a )

I am using vba arrays because for your values work that is the best approach in Excel ( https://excelfox.com/forum/showthread.php/2577-Appendix-Thread-(-Codes-for-other-Threads-(-Avinash-)-)?p=14628&viewfull=1#post14628 )
I do not delete rows, so I do no backward looping
Instead I collect indices of the rows I want to have = rows which are not deleted. For you test data, the rows I want are 1 4 5 6 7 8 9 ( rows 2 and 3 ) are not wanted

[DocAElstein]

Macro solution for Problem 2 ( Problem2b ) - Problem 2 https://excelfox.com/forum/showthread.php/2364-Delete-rows-based-on-match-criteria-in-two-excel-files?p=14648&viewfull=1#post14648

This is a conventional solution Problem2b like the ones you have seen a lot of in the last few days. It deletes the rows ( rows 2 and 3 )




' https://excelfox.com/forum/showthread.php/2577-Appendix-Thread-(-Codes-for-other-Threads-(-Avinash-)-)?p=14646&viewfull=1#post14646
' Problem 2b conventional ' https://excelfox.com/forum/showthread.php/2582-delete-entire-row-by-vbA
Sub DeleteRows()
Rem 1 Worksheets data info
Dim WbABC As Workbook, WsABC As Worksheet
Set WbABC = Workbooks.Open(ThisWorkbook.path & "\ABC.xls")
Set WsABC = WbABC.Worksheets.Item(1)
Dim WbDEF As Workbook, WsDEF As Worksheet
Set WbDEF = Workbooks.Open(ThisWorkbook.path & "\DEF PROBLEM 2.xlsx")
Set WsDEF = WbABC.Worksheets.Item(1)
Dim LrABC As Long, LrDEF As Long
Let LrABC = WsABC.Range("A" & WsABC.Rows.Count & "").End(xlUp).Row ' Dynamically getting the last row in worksheet referenced by WsABC
Let LrDEF = WsDEF.Range("B" & WsDEF.Rows.Count & "").End(xlUp).Row ' Dynamically getting the last row in worksheet referenced by WsDEF
Dim rngSrch As Range
Set rngSrch = WsDEF.Range("B1:B" & LrDEF & "")
Dim arrDta() As Variant
Let arrDta() = WsABC.Range("I1:I" & LrABC & "").Value2
Rem 2 Do it
Dim Cnt
For Cnt = LrABC To 2 Step -1
Dim MtchedCel As Variant
Set MtchedCel = rngSrch.Find(what:=arrDta(Cnt, 1), After:=rngSrch.Item(1), LookIn:=xlValues, LookAt:=xlWhole, SearchDirection:=xlNext, MatchCase:=True)
If Not MtchedCel Is Nothing Then ' Range.Find would return nothing if it did not find a match
' If it was Not Nothing then there was a match = condition to delete
WsABC.Rows(Cnt).EntireRow.Delete Shift:=xlUp ' The row is deleted , and so we have a space which is filled by shifting all rows in the worksheet Up
Else ' MtchedCel is Nothing
' The attempt at a match failed, we got Nothing this is the condition to do nothing
End If
Next Cnt
Rem Close save workbooks
WbABC.Close Savechanges:=True ' Save the file and close it
WbDEF.Close ' Close file. No changes were made
End Sub

[DocAElstein]

Macro for this Post
https://excelfox.com/forum/showthread.php/2364-Delete-rows-based-on-match-criteria-in-two-excel-files?p=14658&viewfull=1#post14658
https://excelfox.com/forum/showthread.php/2590-If-column-C-has-blank-cell-then-delete-that-entire-row?p=14658&viewfull=1#post14658


Sub OnlyHaveRowsWhereColumnCisNotEmpty() '
Rem 1 Workbooks, Worksheets info
' Dim Paf As String: Let Paf = ThisWorkbook.path ' - The path where all workbooks are CHANGE TO SUIT
Dim arrWbs() As Variant
Let arrWbs() = Array(ThisWorkbook.path & "\Book1.xlsx", ThisWorkbook.path & "\Book2.xlsx") ' - CHANGE TO SUIT
Let arrWbs() = Array("C:\Users\WolfieeeStyle\Book1.xlsx", "C:\Users\WolfieeeStyle\Desktop\Book2.xlsx", "C:\Users\Desktop\MyBook.xlsx") '

Dim Wb As Workbook, Ws As Worksheet
Rem 2 Looping through all files
Dim Stear As Variant
For Each Stear In arrWbs()
' 2a Worksheets data info
Set Wb = Workbooks.Open(Stear)
' Set Wb = Workbooks.Open(Paf & "\" & Stear)
Set Ws = Wb.Worksheets.Item(1)
Dim LrC As Long: Let LrC = Ws.Range("C" & Ws.Rows.Count & "").End(xlUp).Row ' Dynamically getting the last row in worksheet referenced by Ws
Dim arrC() As Variant: Let arrC() = Ws.Range("C1:C" & LrC & "").Value2
' 2b row indicies of rows not to be deleted
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) ' take off last space
' 2c Get the indicies in a vertical array, since the "magic code line" needs a vertical array
Dim Rws() As String: Let Rws() = Split(strRws, " ", -1, vbBinaryCompare) ' This gives us a 1 dimensional "horizontal" array ( starting at indicie 0 )
Dim RwsT() As Variant: ReDim RwsT(1 To UBound(Rws) + 1, 1 To 1) ' +1 is needed because the
For Cnt = 1 To UBound(Rws) + 1
Let RwsT(Cnt, 1) = Rws(Cnt - 1)
Next Cnt
' 2d get the output array from "magic code line" :
Dim Clms() As Variant
Let Clms() = Evaluate("=Column(A:U)") ' for columns 1 2 3 4 5 6 7 8 9 10 11 12 13 14 125 16 17 18 19 20 21
Dim arrOut() As Variant
Let arrOut() = Application.Index(Ws.Cells, RwsT(), Clms()) ' Magic code line http://www.eileenslounge.com/viewtopic.php?p=265384#p265384 http://www.eileenslounge.com/viewtopic.php?p=265384&sid=39b6d764de41f462fe66f62816e5d789#p265384 See also https://www.excelforum.com/excel-new-users-basics/1099995-application-index-with-look-up-rows-and-columns-arguments-as-vba-arrays.html#post4571172 , http://www.excelfox.com/forum/showthread.php/2145-Excel-VBA-Interception-and-Implicit-Intersection-and-VLookUp for full explanation
' 2e replace worksheet data with modified data arrayOut
Ws.Cells.ClearContents
Let Ws.Range("A1").Resize(UBound(arrOut(), 1), 21).Value2 = arrOut() ' We can paste in one go the contents of an arrasy to a worksheet range
'2f
Let strRws = "" ' this is important or else in the next file loop, strRws it will still have values from the last loop
Next Stear
End Sub




Note: You must change this line

Let arrWbs() = Array(ThisWorkbook.path & "\Book1.xlsx", ThisWorkbook.path & "\Book2.xlsx") ' - CHANGE TO SUIT

To something like this

Let arrWbs() = Array("C:\Users\WolfieeeStyle\Book1.xlsx", "C:\Users\WolfieeeStyle\Desktop\Book2.xlsx", "C:\Users\Desktop\MyBook.xlsx") '

[DocAElstein]

Getting URL for later use of this post

[DocAElstein]

Macro for this post
https://excelfox.com/forum/showthread.php/2364-Delete-rows-based-on-match-criteria-in-two-excel-files?p=14664&viewfull=1#post14664


The two changes for the dynamic column is
_1 a new line
Dim Lc As Long: Let Lc = Ws.UsedRange.Columns.Count - Ws.UsedRange.Column + 1
_2 Modify the column indicia code line, Clms() = Evaluate("=Column(A:U)")
Clms() = Evaluate("=Column(A:" & CL(Lc) & ")")
_3 You need to include the function CL( )

Modified macro and required function, CL( )


Sub OnlyHaveRowsWhereColumnCisNotEmptyDynamicColumns() ' https://excelfox.com/forum/showthread.php/2577-Appendix-Thread-(-Codes-for-other-Threads-(-Avinash-)-)?p=14663&viewfull=1#post14663 https://excelfox.com/forum/showthread.php/2577-Appendix-Thread-(-Codes-for-other-Threads-(-Avinash-)-)?p=14657#post14657
Rem 1 Workbooks, Worksheets info
' Dim Paf As String: Let Paf = ThisWorkbook.path ' - The path where all workbooks are CHANGE TO SUIT
Dim arrWbs() As Variant
Let arrWbs() = Array(ThisWorkbook.path & "\Book1.xlsx", ThisWorkbook.path & "\Book2.xlsx") ' - CHANGE TO SUIT
' Let arrWbs() = Array("C:\Users\WolfieeeStyle\Book1.xlsx", "C:\Users\WolfieeeStyle\Desktop\Book2.xlsx", "C:\Users\Desktop\MyBook.xlsx") '

Dim Wb As Workbook, Ws As Worksheet
Rem 2 Looping through all files
Dim Stear As Variant
For Each Stear In arrWbs()
' 2a Worksheets data info
Set Wb = Workbooks.Open(Stear)
' Set Wb = Workbooks.Open(Paf & "\" & Stear)
Set Ws = Wb.Worksheets.Item(1)
Dim LrC As Long: Let LrC = Ws.Range("C" & Ws.Rows.Count & "").End(xlUp).Row ' Dynamically getting the last row in worksheet referenced by Ws
Dim Lc As Long: Let Lc = Ws.UsedRange.Columns.Count - Ws.UsedRange.Column + 1 ' Dynamically getting the last column for the used range in Ws
Dim arrC() As Variant: Let arrC() = Ws.Range("C1:C" & LrC & "").Value2
' 2b row indicies of rows not to be deleted
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) ' take off last space
' 2c Get the indicies in a vertical array, since the "magic code line" needs a vertical array
Dim Rws() As String: Let Rws() = Split(strRws, " ", -1, vbBinaryCompare) ' This gives us a 1 dimensional "horizontal" array ( starting at indicie 0 )
Dim RwsT() As Variant: ReDim RwsT(1 To UBound(Rws) + 1, 1 To 1) ' +1 is needed because the
For Cnt = 1 To UBound(Rws) + 1
Let RwsT(Cnt, 1) = Rws(Cnt - 1)
Next Cnt
' 2d get the output array from "magic code line" :
Dim Clms() As Variant
' Let Clms() = Evaluate("=Column(A:U)") ' for columns 1 2 3 4 5 6 7 8 9 10 11 12 13 14 125 16 17 18 19 20 21
Let Clms() = Evaluate("=Column(A:" & CL(Lc) & ")")
Dim arrOut() As Variant
Let arrOut() = Application.Index(Ws.Cells, RwsT(), Clms()) ' Magic code line http://www.eileenslounge.com/viewtopic.php?p=265384#p265384 http://www.eileenslounge.com/viewtopic.php?p=265384&sid=39b6d764de41f462fe66f62816e5d789#p265384 See also https://www.excelforum.com/excel-new-users-basics/1099995-application-index-with-look-up-rows-and-columns-arguments-as-vba-arrays.html#post4571172 , http://www.excelfox.com/forum/showthread.php/2145-Excel-VBA-Interception-and-Implicit-Intersection-and-VLookUp for full explanation
' 2e replace worksheet data with modified data arrayOut
Ws.Cells.ClearContents
Let Ws.Range("A1").Resize(UBound(arrOut(), 1), 21).Value2 = arrOut() ' We can paste in one go the contents of an arrasy to a worksheet range
'2f
Let strRws = "" ' this is important or else in the next file loop, strRws it will still have values from the last loop
Next Stear
End Sub

' https://excelfox.com/forum/showthread.php/1546-TESTING-Column-Letter-test-Sort-Last-Row?p=7214#post7214
Public Function CL(ByVal lclm As Long) As String ' http://www.excelforum.com/development-testing-forum/1101544-thread-post-appendix-no-reply-needed-please-do-not-delete-thanks-4.html#post4213980
Do: Let CL = Chr(65 + (((lclm - 1) Mod 26))) & CL: Let lclm = (lclm - (1)) \ 26: Loop While lclm > 0
End Function




macro1.xlsm : https://app.box.com/s/tl3rs9693jwuv9c2w36ok8fpaewuf0ta
macro2.xlsm : https://app.box.com/s/t35238lm19bj6y0p6m6p68uaknsdf37z

[DocAElstein]

For later use

[DocAElstein]

Macro for this post
https://excelfox.com/forum/showthread.php/2455-copy-paste-calculate-Cell-value-based-on-calculations-amp-comparisonsother-cells-same-row-Decimal-places?p=14675&viewfull=1#post14675



Sub DecimalPlaceAdjustment()
Rem 1 Worksheets info
Dim Wb1 As Workbook, Wb2 As Workbook
Set Wb1 = Workbooks("1.xls") ' ' CHANGE TO SUIT
Set Wb2 = Workbooks("sample2.xlsx")
Dim Ws1 As Worksheet
Set Ws1 = Wb1.Worksheets.Item(1)
Dim Ws2 As Worksheet
Set Ws2 = Wb2.Worksheets.Item(1)
Dim Lr1 As Long, Lr2 As Long
Let Lr1 = Ws1.Range("A" & Ws1.Rows.Count).End(xlUp).Row ' http://www.excelfox.com/forum/showthread.php/2345-Appendix-Thread-(-Codes-for-other-Threads-HTML-Tables-etc-)?p=11466&viewfull=1#post11466 Making Lr dynamic ( using rng.End(XlUp) for a single column. )
Let Lr2 = Ws2.Range("A" & Ws1.Rows.Count).End(xlUp).Row
Dim arr1I() As Variant, arr2B() As Variant, arr2E() As Variant, arr1H() As Variant ' , arr1G() As Variant
Let arr2B() = Ws2.Range("B1:B" & Lr2 & "").Value2
' Let arr1G() = Ws1.Range("G1:G" & Lr2 & "").Value2
Let arr1I() = Ws1.Range("I1:I" & Lr1 & "").Value2
Let arr2E() = Ws2.Range("E1:E" & Lr2 & "").Value2
Let arr1H() = Ws1.Range("H1:H" & Lr1 & "").Value2
Rem 2 ' Do it
Dim Cnt
For Cnt = 2 To Lr1 ' going through data down column I , Ws1
'2a check for match data from column I Ws1 in column B Ws2
Dim MtchRes As Variant
Let MtchRes = Application.Match(arr1I(Cnt, 1), arr2B(), 0)
If Not IsError(MtchRes) Then ' If MtchRes did not error then it tells us where along the match was found
Dim LHInt As Long: Let LHInt = Len(Int(arr1H(Cnt, 1))) ' character Length of the integer of the value in H
Let arr2E(MtchRes, 1) = Replace(arr2E(MtchRes, 1), ".", "", 1, 1, vbBinaryCompare) ' remove any decimal place in the matched row in 2.xlsx in column E
Let arr2E(MtchRes, 1) = Left(arr2E(MtchRes, 1), LHInt) & "." & Mid(arr2E(MtchRes, 1), LHInt + 1)
Else
' No match was found , so do nothing
End If
Next Cnt
Rem 3 Change column E in sample2.xlsx
Let Ws2.Range("E1:E" & Lr2 & "").Value2 = arr2E()
End Sub

[DocAElstein]

Notes in support of this Thread
https://excelfox.com/forum/showthread.php/2596-Cut-amp-paste-between-sheets

We are using the code line like
Index(Cells, Rws(), Clms)

This requires the array of required row numbers from the original worksheet, held in Rws()

These show the Row numbers concerned

Original range. ( First Worksheet Before )
_____ Workbook: 1.xls ( Using Excel 2007 32 bit )

Rows in OriginalOriginalABCDEFGHIJK

R1
1ExchangeSymbolSeries/ExpiryOpenHighLow Prev CloseLTP

R2
2NSEACCEQ
1265
1265
1246.5
1275.3
1247
22BUY
1167.6105

R3
3NSEADANIENTEQ
151.85
165.45
151.4
151.85
152.35
25BUY
141.0465

R4
4NSEHDFCEQ
1805
1826
1805
1809.3
1786.05
1330BUY
1624.0295

R5
5NSEHDFCBANKEQ
985
988.4
970
991.85
971.85
1333BUY
854.6115

R6
6NSEHEROMOTOCOEQ
2316
2345
2300
2292.25
2311.8
1348SHORT
2024.154

R7
7NSEHINDALCOEQ
145.9
147.45
142.45
146.95
143.6
1363BUY
119.9375
Worksheet: 1-Sheet1 Output 17-21 July


First worksheet After:

_____ Workbook: 1.xls ( Using Excel 2007 32 bit )

Rows in OriginalFirst Worksheet AfterABCDEFGHIJK

R1
1ExchangeSymbolSeries/ExpiryOpenHighLow Prev CloseLTP

R2
2NSEACCEQ
1265
1265
1246.5
1275.3
1247
22BUY
1167.6105

R4
3NSEHDFCEQ
1805
1826
1805
1809.3
1786.05
1330BUY
1624.0295
Worksheet: 1-Sheet1 Output 17-21 July


New worksheet after
_____ Workbook: 1.xls ( Using Excel 2007 32 bit )

Rows in OriginalNew SheetBCDEFGHIJK

R1
1ExchangeSymbolSeries/ExpiryOpenHighLow Prev CloseLTP

R3
2NSEADANIENTEQ
151.85
165.45
151.4
151.85
152.35
25BUY
141.0465

R5
3NSEHDFCBANKEQ
985
988.4
970
991.85
971.85
1333BUY
854.6115

R6
4NSEHEROMOTOCOEQ
2316
2345
2300
2292.25
2311.8
1348SHORT
2024.154

R7
5NSEHINDALCOEQ
145.9
147.45
142.45
146.95
143.6
1363BUY
119.9375
Worksheet: 1-Sheet1 Output 17-21 July

[DocAElstein]

Macro solution for these posts

https://excelfox.com/forum/showthread.php/2596-Cut-amp-paste-between-sheets
https://www.excelforum.com/excel-programming-vba-macros/1322307-cut-and-paste-between-sheets.html
http://www.eileenslounge.com/viewtopic.php?p=271799&sid=77d3a86512f1233612285535d0bf154f#p271799



Sub MoveSomeDataRowsToNewWorksheetBasedOnConditions()
Rem 1 worksheets data info
Dim Wb1 As Workbook
Set Wb1 = Workbooks("1.xls")
Dim Ws1 As Worksheet
Set Ws1 = Wb1.Worksheets.Item(1)
Dim Lr1 As Long: Let Lr1 = Ws1.Range("A" & Ws1.Rows.Count & "").End(xlUp).Row ' Make Lr Dynamic : https://excelfox.com/forum/showthread.php/2364-Delete-rows-based-on-match-criteria-in-two-excel-files?p=11467&viewfull=1#post11467 https://excelfox.com/forum/showthread.php/2364-Delete-rows-based-on-match-criteria-in-two-excel-files?p=14565&viewfull=1#post14565
Dim arr1DEF() As Variant
Let arr1DEF() = Ws1.Range("D1:F" & Lr1 & "").Value2
Rem 2 Get the row numbers wanted in the New worksheet and in the first worksheet after
'2a(i) Build the string indicies based on the criterias
Dim str1 As String, str2 As String ' strings to build for Row numbers for the two sheets after
Let str1 = "1": Let str2 = "1" ' Both Worksheets should have the headers
Dim Cnt
For Cnt = 2 To Lr1 Step 1
If arr1DEF(Cnt, 1) = arr1DEF(Cnt, 2) Or arr1DEF(Cnt, 1) = arr1DEF(Cnt, 3) Then '
' Do nothing .. For this macro I want to add here the rows which will still be there in the original worksheet After
Let str1 = str1 & " " & Cnt
Else
' ..........."...put that data into new worksheet by creating a new sheet in it & remove that data from current sheet........"
Let str2 = str2 & " " & Cnt ' this will be used for the new worksheet It is not being used for the first Worksheet after. So that will mean that these rows do not appear in the first worksheet after ClearContentsing it
End If
Next Cnt
'2a(ii)
Dim Rws1() As String, Rws2() As String
Let Rws1() = Split(str1, " ", -1, vbBinaryCompare): Let Rws2() = Split(str2, " ", -1, vbBinaryCompare)
'2b) Make the "virtical" row indicie array needed in the "Magic code line"
Dim RwsV1() As String: ReDim RwsV1(1 To UBound(Rws1()) + 1, 1 To 1): Dim RwsV2() As String: ReDim RwsV2(1 To UBound(Rws2()) + 1, 1 To 1)
For Cnt = 1 To UBound(Rws1()) + 1 ' +1 is needed because the array returned by Split is a 1D array starting at 0
Let RwsV1(Cnt, 1) = Rws1(Cnt - 1)
Next Cnt
For Cnt = 1 To UBound(Rws2()) + 1 ' +1 is needed because the array returned by Split is a 1D array starting at 0
Let RwsV2(Cnt, 1) = Rws2(Cnt - 1)
Next Cnt
Rem 3 Output
Dim Clms() As Variant: Let Clms() = Evaluate("=COLUMN(A:K)") ' ** CHANGE TO SUIT ** This is currently for columns A B C ...K 1 2 3..... 11 For non consequtive columns you can use like Array("1", "3", "26") - that last example gives in the new range just columns A C Z from the original worksheet
'3a new Worksheet
Worksheets.Add After:=Worksheets.Item(1)
Let ActiveSheet.Name = "New Worksheet"
Dim arrOut() As Variant: Let arrOut() = Application.Index(Ws1.Cells, RwsV2(), Clms()) ' ' The magic code line --- ' "Magic code line" http://www.eileenslounge.com/viewtopic.php?p=265384#p265384 http://www.eileenslounge.com/viewtopic.php?p=265384&sid=39b6d764de41f462fe66f62816e5d789#p265384 See also https://www.excelforum.com/excel-new-users-basics/1099995-application-index-with-look-up-rows-and-columns-arguments-as-vba-arrays.html#post4571172 , http://www.excelfox.com/forum/showthread.php/2145-Excel-VBA-Interception-and-Implicit-Intersection-and-VLookUp for full explanation
Let Worksheets("New Worksheet").Range("A1").Resize(UBound(arrOut(), 1), 11).Value2 = arrOut() ' We can paste out an array of values in one go to a spreadsheet range. Here A1 is taken as top right which is then resized to the size of the field of data values in arrOut()
'3b) Original worksheet after
Let arrOut() = Application.Index(Ws1.Cells, RwsV1(), Clms()) ' ' The magic code line --- ' "Magic code line" http://www.eileenslounge.com/viewtopic.php?p=265384#p265384 http://www.eileenslounge.com/viewtopic.php?p=265384&sid=39b6d764de41f462fe66f62816e5d789#p265384 See also https://www.excelforum.com/excel-new-users-basics/1099995-application-index-with-look-up-rows-and-columns-arguments-as-vba-arrays.html#post4571172 , http://www.excelfox.com/forum/showthread.php/2145-Excel-VBA-Interception-and-Implicit-Intersection-and-VLookUp for full explanation
'Ws1.UsedRange.ClearContents
Ws1.Range("A1:K" & Lr1 & "").ClearContents
Let Ws1.Range("A1").Resize(UBound(arrOut(), 1), 11).Value2 = arrOut()
End Sub

[DocAElstein]

Macro for this post
https://excelfox.com/forum/showthread.php/2583-Copy-row-from-one-workbook-to-another-workbook-based-on-conditions-in-another-Workbook?p=14598#post14598



' Copy row from one workbook to another workbook based on conditions in another Workbooks
' https://excelfox.com/forum/showthread.php/2583-Macro-Correction

' https://excelfox.com/forum/showthread.php/2583-Copy-row-from-one-workbook-to-another-workbook-based-on-conditions-in-another-Workbooks

Sub CopyRow1orRow3fromoneworkbooktoanotherworkbookbase donconditionsinanotherWorkbooks() '
Rem 1 worksheets info
Dim Ws1 As Worksheet, WsOF As Worksheet, WsBO As Worksheet
Set Ws1 = Workbooks("1.xls").Worksheets.Item(1): Set WsBO = Workbooks("BasketOrder.xlsx").Worksheets.Item(1): Set WsOF = Workbooks("OrderFormat.xlsx").Worksheets.Item(1)
Dim Lr1 As Long: Let Lr1 = Ws1.Range("A" & Ws1.Rows.Count & "").End(xlUp).Row ' Make Lr Dynamic : https://excelfox.com/forum/showthread.php/2364-Delete-rows-based-on-match-criteria-in-two-excel-files?p=11467&viewfull=1#post11467 https://excelfox.com/forum/showthread.php/2364-Delete-rows-based-on-match-criteria-in-two-excel-files?p=14565&viewfull=1#post14565
Dim arr1D() As Variant, arr1H() As Variant
Let arr1D() = Ws1.Range("D1:D" & Lr1 & "").Value2: Let arr1H() = Ws1.Range("H1:H" & Lr1 & "").Value2 '
Rem 2 Do it ...
'2a We want the rows Row 1 or Row 3 in a "virtical" array
Dim RwsV() As String: ReDim RwsV(1 To Lr1 - 1, 1 To 1) ' I column 2 Dimensional Array
Dim Cnt
For Cnt = 1 To UBound(RwsV(), 1) ' we want a row indicie of 1 or 3 for each row to be pased to BasketOrder.xlsx
If arr1H(Cnt + 1, 1) > arr1D(Cnt + 1, 1) Then ' If column H of 1.xls is greater than column D of 1.xls then
Let RwsV(Cnt, 1) = "3" ' third row of orderformat.xlsx
ElseIf arr1H(Cnt + 1, 1) < arr1D(Cnt + 1, 1) Then ' If column H of 1.xls is smaller than column D of 1.xls
Let RwsV(Cnt, 1) = "1" ' first row of orderformat.xlsx
Else

End If
Next Cnt
Rem 3 output
Dim Clms() As Variant: Let Clms() = Evaluate("=COLUMN(A:U)") ' ** CHANGE TO SUIT ** This is currently for columns A B C ...U 1 2 3..... 21 For non consequtive columns you can use like Array("1", "3", "26") - that last example gives in the new range just columns A C Z from the original worksheet
Dim arrOut() As Variant: Let arrOut() = Application.Index(WsOF.Cells, RwsV(), Clms()) ' ' The magic code line --- ' "Magic code line" http://www.eileenslounge.com/viewtopic.php?p=265384#p265384 http://www.eileenslounge.com/viewtopic.php?p=265384&sid=39b6d764de41f462fe66f62816e5d789#p265384 See also https://www.excelforum.com/excel-new-users-basics/1099995-application-index-with-look-up-rows-and-columns-arguments-as-vba-arrays.html#post4571172 , http://www.excelfox.com/forum/showthread.php/2145-Excel-VBA-Interception-and-Implicit-Intersection-and-VLookUp for full explanation
Let WsBO.Range("A1").Resize(Lr1 - 1, 21).Value2 = arrOut() ' We can paste out an array of values in one go to a spreadsheet range. Here A1 is taken as top right which is then resized to the size of the field of data values in arrOut()
End Sub

[DocAElstein]

Post to get URL

[DocAElstein]

post for later use, ( to get URL already now )

[DocAElstein]

Some notes in support of these Threads and posts
This thread (https://www.eileenslounge.com/viewtopic.php?f=30&t=35100), that thread (https://www.eileenslounge.com/viewtopic.php?f=30&t=34629)

Hans penultimate


' https://eileenslounge.com/viewtopic.php?p=272599#p272599 https://eileenslounge.com/viewtopic.php?p=272605#p272605
Sub STEP2() ' Hans penultimate
Dim w1 As Workbook
Set w1 = ActiveWorkbook ' CHANGE TO SUIT
Dim ws1 As Worksheet
'Set ws1 = w1.Worksheets.Item(2)
Set ws1 = w1.Worksheets("HansPenultimate") ' CHANGE TO SUIT
Dim MyData As String
Dim lineData() As String, strData() As String, myFile As String
Dim i As Long, rng As Range

'On Error Resume Next

'myFile = "C:\Users\WolfieeeStyle\Desktop\NSEVAR.txt"
myFile = ThisWorkbook.Path & "\NSEVAR.txt" ' CHANGE TO SUIT
Open myFile For Binary As #1
MyData = Space$(LOF(1))
Get #1, , MyData
Close #1

lineData() = Split(MyData, vbNewLine)
Set rng = ws1.Range("A2")

For i = 0 To UBound(lineData)

strData = Split(lineData(i), ",")

rng.Offset(i, 0).Resize(1, UBound(strData) + 1) = strData

Next
' ws1.Range("A:A").Select
'
'
' Selection.TextToColumns Destination:=ws1.Range("A1"), DataType:=xlDelimited, _
' TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
' Semicolon:=False, Comma:=True, Space:=False, Other:=False, OtherChar _
' :=",", FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, _
' 1), Array(6, 1), Array(7, 1), Array(8, 1), Array(9, 1), Array(10, 1)), _
' TrailingMinusNumbers:=True

ws1.Columns("A:Z").AutoFit


ws1.Range("A1").Select

w1.Save

End Sub


My modifed from last (https://www.eileenslounge.com/viewtopic.php?p=269104#p269104) macro (https://www.eileenslounge.com/viewtopic.php?p=269105#p269105)

Sub TextFileToExcel_GroundhogDay12() ' http://www.eileenslounge.com/viewtopic.php?f=30&t=35100 http://www.eileenslounge.com/viewtopic.php?p=268809#p268809
Rem 1 Workbooks, Worksheets info
Dim Wb As Workbook, Ws As Worksheet
Set Wb = Workbooks("macro.xlsb") ' CHANGE TO SUIT
' Set Ws = Wb.Worksheets.Item(2) ' second worksheet
Set Ws = Wb.Worksheets("Mylastmacro") ' CHANGE TO SUIT
Dim lr As Long: Let lr = Ws.Range("A" & Ws.Rows.Count & "").End(xlUp).Row ' http://www.excelfox.com/forum/showthread.php/2345-Appendix-Thread-(-Codes-for-other-Threads-HTML-Tables-etc-)?p=11466&viewfull=1#post11466 Making Lr dynamic ( using rng.End(XlUp) for a single column. )
Dim NxtRw As Long
If lr = 1 And Ws.Range("A1").Value = "" Then
Let NxtRw = 1 ' If there is no data in the worksheet we want the first row to be the start row
Else
Let NxtRw = lr + 1 ' If there is data in the worksheet, we want the data to be posted after the last used row
End If
Rem 2 Text file info
' 2a) get the text file as a long single string
Dim FileNum As Long: Let FileNum = FreeFile(1) ' https://msdn.microsoft.com/en-us/vba/language-reference-vba/articles/freefile-function
Dim PathAndFileName As String, TotalFile As String
Let PathAndFileName = ThisWorkbook.Path & "\" & "NSEVAR.txt" ' CHANGE TO SUIT From vixer zyxw1234 : http://www.eileenslounge.com/viewtopic.php?f=30&t=34629 DF.txt https://app.box.com/s/gw941dh9v8sqhvzin3lo9rfc67fjsbic
Open PathAndFileName For Binary As #FileNum 'Open Route to data. Binary is a fundemental type data input...
TotalFile = Space(LOF(FileNum)) '....and wot recives it has to be a string of exactly the right length
Get #FileNum, , TotalFile
Close #FileNum
' 2b) Split into wholes line _ splitting the text file into rows by splitting by vbCr & vbLf ( Note vbCr & vbLf = vbNewLine )
Dim arrRws() As String: Let arrRws() = Split(TotalFile, vbCr & vbLf, -1, vbBinaryCompare)
Dim RwCnt As Long: Let RwCnt = UBound(arrRws()) + 1 ' +1 is nedeed as the Split Function returns indicies 0 1 2 3 4 5 etc...
' we can now make an array for all the rows, and we know our columns are A-J = 10 columns
Dim arrOut() As String: ReDim arrOut(1 To RwCnt, 1 To 10)

Rem 3 An array is built up by _....
Dim Cnt As Long
For Cnt = 1 To RwCnt ' _.. considering each row of data
Dim arrClms() As String
Let arrClms() = Split(arrRws(Cnt - 1), ",", -1, vbBinaryCompare) ' ___.. splitting each row into columns by splitting by the comma
Dim Clm As Long '
For Clm = 1 To UBound(arrClms()) + 1
Let arrOut(Cnt, Clm) = arrClms(Clm - 1)
Next Clm
Next Cnt

Rem 4 Finally the array is pasted to the worksheet at the next free row
' Let Ws.Range("A" & NxtRw & "").Resize(RwCnt, 10).Value2 = arrOut()
Let Ws.Range("A" & NxtRw & ":J" & RwCnt + (NxtRw - 1) & "").Value2 = arrOut()
' Ws.Columns("A:J").AutoFit
Rem 5 to remove http://www.eileenslounge.com/viewtopic.php?p=272606&sid=7e8ad1b708dd49a811498ccac6b1e092#p272606 ..... when i click on any cell that has output there is an option numbers stored as text, convert to numbers,help on this error,ignore error,edit in formula bar,error checking options(these are the options coming)
' Let Ws.Range("A" & NxtRw & ":J" & RwCnt + (NxtRw - 1) & "").Value2 = Evaluate("=IF(A" & NxtRw & ":J" & RwCnt + (NxtRw - 1) & "="""","""",IF(ISERROR(1*A" & NxtRw & ":J" & RwCnt + (NxtRw - 1) & "),A" & NxtRw & ":J" & RwCnt & ",1*A" & NxtRw & ":J" & RwCnt + (NxtRw - 1) & "))")
' Let Ws.Range("B" & NxtRw & ":D" & RwCnt + (NxtRw - 1) & "").Value2 = Evaluate("=IF(B" & NxtRw & ":D" & RwCnt + (NxtRw - 1) & "="""","""",IF(ISERROR(1*B" & NxtRw & ":D" & RwCnt + (NxtRw - 1) & "),B" & NxtRw & ":D" & RwCnt & ",1*B" & NxtRw & ":D" & RwCnt + (NxtRw - 1) & "))")
' Let Ws.Range("A" & NxtRw & ":J" & RwCnt + (NxtRw - 1) & "").Value2 = Evaluate("=IF(A" & NxtRw & ":J" & RwCnt + (NxtRw - 1) & "="""","""",IF(ISNUMBER(1*A" & NxtRw & ":J" & RwCnt + (NxtRw - 1) & "),1*A" & NxtRw & ":J" & RwCnt + (NxtRw - 1) & ",A" & NxtRw & ":J" & RwCnt + (NxtRw - 1) & "))")

End Sub


Hans final macro (http://www.eileenslounge.com/viewtopic.php?p=272608#p272608) in this thread (https://www.eileenslounge.com/viewtopic.php?f=30&t=35100)


Sub STEP2_() ' to remove http://www.eileenslounge.com/viewtopic.php?p=272606&sid=7e8ad1b708dd49a811498ccac6b1e092#p272606 ..... when i click on any cell that has output there is an option numbers stored as text, convert to numbers,help on this error,ignore error,edit in formula bar,error checking options(these are the options coming)
Dim w1 As Workbook
Dim ws1 As Worksheet
Dim MyData As String
Dim lineData() As String, strData() As String, myFile As String
Dim i As Long, rng As Range

'myFile = "C:\Users\WolfieeeStyle\Desktop\NSEVAR.txt"
myFile = ThisWorkbook.Path & "\NSEVAR.txt"

Open myFile For Binary As #1
MyData = Space$(LOF(1))
Get #1, , MyData
Close #1

lineData() = Split(MyData, vbNewLine)
Set w1 = ActiveWorkbook
Set ws1 = w1.Worksheets.Item(2)
With ws1.Range("A2").Resize(UBound(lineData) + 1)
.Value = Application.Transpose(lineData)
.TextToColumns Destination:=ws1.Range("A2"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, Comma:=True, _
FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), _
Array(5, 1), Array(6, 1), Array(7, 1), Array(8, 1), Array(9, 1), Array(10, 1))
End With
End Sub

[DocAElstein]

Post for later use, ( to get URL already now ) - .

testing



“Moderator” Notice

**I am Banning you to prevent you making any more postings here of the type you have been making here and elsewhere under hundreds of different user names at many of the English speaking Excel and Office help forums for the last couple of years.

The type of post that you have been posting suggest that
_ You may be one person or a team of many people working at something organised like a Call Centre.
_ You have almost no understanding of the English language
_ You may not have a computer and may have no access to Excel
_ You have no interest in Excel or Excel VBA
_ You have almost no knowledge or interest in any of the questions that you are asking
_ You may be simply offering a service of posting other peoples questions and supplying them with any answers you get.
_ You may be part of the development of a question asking and Replying Bot

_ In some cases, something extremely simple to understand, has been explained to you in great detail , even graphically, such that even a small mentally handicapped child could understand it and remember it. Despite this, you continually ask exactly the same question over and over again: If you are part of a team interested in only posting questions and taking the answer, then you are very badly organised,
Or
There is no real intelligence behind what is producing your questions and posts
_ One of the things you consistently do after receiving a macro is to delete all explanations, explaining 'comments and all files associated, and indeed it appears as if you try to remove almost all record of the coding and the question and answer. This further encourages the posting of the same or similar questions over and over again.

Whatever you are attempting to do, it appears to be extremely, almost insanely, inefficient ,
compared to
a single person with a computer and Excel, and a minimum of basic Excel VBA knowledge trying to achieve the same.

The main reason for the ban is
Whatever you are attempting to do, it is requiring 10-100 times more time than is typically required of helpers at a forum. All indications are that what you are doing will fail to achieve anything, and is therefore a total waste of everyone’s time. At excelfox, the current small number of helpers have only a limited amount of time, but even if we had more members, excelfox would not be the place for you##

These are some suggestions, from me, on how you should continue
_ If you intend to continue, regardless of any of my previous suggestions, in postings of the type as you have done in the past, then you should think about making some changes to your wording, introduce some new canned replies, possibly organise a new set of similar questions and post at the major forums, such as mrexcel.com, excelforum.com, ozgrid.com
_ If you wish to make a career out of posting questions and getting answers with out having any real intentions of thinking about anything, then excelfox is not the forum for you to post in. Most of the smaller forums are not the place for you. The larger forums may be able to accommodate you, if you give at least some thought to making it not quite so obvious as you have been doing. Many people do the such. At least half the traffic at such forums originates from such. I have passed many people on to such forums and they are making a successful career based on passing on the work done for them by helpers at the major forums. Such is actually encouraged, all be it , not openly.
_ If you have not understood most of this Moderator Notice , then your first priority should be to improve on your English. Indeed, your apparent understanding and ability in communicating in English suggests that you will achieve nothing whatsoever and fail completely in anything at all involving communicating in English.

_ If you are, as you sometimes told me, actively working on an important personal problem requiring VBA , then you are doing it totally wrongly: You have been on the project already for at least two years and have a mixed up set of codings produced by many different people. Some work . Some don’t. You have not the slightest idea or understanding of any of the codings. You will never be able to use them to any effect. If , on the other hand, you had a computer, with Excel, and spent a few weeks learning VBA, and then carefully studied all the macros that you have been given, then you would be able to answer most of your further questions, and would have at least a chance of being able to use the codings effectively.


##The main purpose of the question section of excelfox is approximately the following:
_1. Promote and improve the understanding of Excel and Excel VBA.
_2. Help people who get stuck on a problem and/or help people who are unsure how to proceed in solving a problem using Excel and Excel VBA.

Your objectives??
I do not know what the true reason is behind your postings. I can’t believe anything you say is your purpose, since you have lied and contradicted yourself in the past. The only thing we know 100% for sure is that your posting types are not for any of the purposes for which the question section of excelfox is intended.
You have had the benefit of the doubt given to you now very many times. You have had lots of chances.
You may be able to continue at some of the major forums, where some people are happy to continue to spend time to answer similar questions from the same source.
I do not think you get any more replies to the types of postings you have been making at excelfox or at any other of the smaller English speaking Forums. You are wasting your time making any such posts from now on.
**I am Banning you, not as any form of punishment, but purely as in the past , it has proven to be the only way to prevent you wasting yours and other peoples time with your postings.
I do wish you luck and success with what ever it is you are attempting to do. But you should not be doing it at excelfox.

[DocAElstein]

Macro in support of this Thread and posts.
This thread (https://www.eileenslounge.com/viewtopic.php?f=30&t=35100),
that thread (https://www.eileenslounge.com/viewtopic.php?f=30&t=34629)
http://www.eileenslounge.com/viewtopic.php?p=272682#p272682
https://eileenslounge.com/viewtopic.php?p=272706#p272706
( and probably a dozen more in the next few months.... )


Sub TextFileToExcel_GroundhogDay12b() ' http://www.eileenslounge.com/viewtopic.php?f=30&t=35100 http://www.eileenslounge.com/viewtopic.php?p=268809#p268809
Rem 1 Workbooks, Worksheets info
Dim Wb As Workbook, Ws As Worksheet
Set Wb = Workbooks("macro.xlsb") ' CHANGE TO SUIT
Set Ws = Wb.Worksheets.Item(2) ' second worksheet
' Set Ws = Wb.Worksheets("Mylastmacro") ' CHANGE TO SUIT
Dim lr As Long: Let lr = Ws.Range("A" & Ws.Rows.Count & "").End(xlUp).Row ' http://www.excelfox.com/forum/showthread.php/2345-Appendix-Thread-(-Codes-for-other-Threads-HTML-Tables-etc-)?p=11466&viewfull=1#post11466 Making Lr dynamic ( using rng.End(XlUp) for a single column. )
Dim NxtRw As Long
If lr = 1 And Ws.Range("A1").Value = "" Then
Let NxtRw = 2 ' If there is no data in the worksheet we want the second row to be the start row
Else
Let NxtRw = lr + 1 ' If there is data in the worksheet, we want the data to be posted after the last used row
End If
Rem 2 Text file info
' 2a) get the text file as a long single string
Dim FileNum As Long: Let FileNum = FreeFile(1) ' https://msdn.microsoft.com/en-us/vba/language-reference-vba/articles/freefile-function
Dim PathAndFileName As String, TotalFile As String
Let PathAndFileName = ThisWorkbook.Path & "\" & "NSEVAR.txt" ' CHANGE TO SUIT From vixer zyxw1234 : http://www.eileenslounge.com/viewtopic.php?f=30&t=34629 DF.txt https://app.box.com/s/gw941dh9v8sqhvzin3lo9rfc67fjsbic NSEVER.txt: https://app.box.com/s/245h7i5nh6an8vw08g8t08fvu30ylih2
Open PathAndFileName For Binary As #FileNum 'Open Route to data. Binary is a fundemental type data input...
TotalFile = Space(LOF(FileNum)) '....and wot recives it has to be a string of exactly the right length
Get #FileNum, , TotalFile
Close #FileNum
' 2b) Split into wholes line _ splitting the text file into rows by splitting by vbCr & vbLf ( Note vbCr & vbLf = vbNewLine )
Dim arrRws() As String: Let arrRws() = Split(TotalFile, vbCr & vbLf, -1, vbBinaryCompare)
Dim RwCnt As Long: Let RwCnt = UBound(arrRws()) + 1 ' +1 is nedeed as the Split Function returns indicies 0 1 2 3 4 5 etc...
' we can now make an array for all the rows, and we know our columns are A-J = 10 columns
Dim arrOut() As String: ReDim arrOut(1 To RwCnt, 1 To 10)

Rem 3 An array is built up by _....
Dim Cnt As Long
For Cnt = 1 To RwCnt ' _.. considering each row of data
Dim arrClms() As String
Let arrClms() = Split(arrRws(Cnt - 1), ",", -1, vbBinaryCompare) ' ___.. splitting each row into columns by splitting by the comma
Dim Clm As Long '
For Clm = 1 To UBound(arrClms()) + 1
Let arrOut(Cnt, Clm) = arrClms(Clm - 1)
Next Clm
Next Cnt

Rem 4 Finally the array is pasted to the worksheet at the next free row
' Let Ws.Range("A" & NxtRw & "").Resize(RwCnt, 10).Value2 = arrOut()
Let Ws.Range("A" & NxtRw & ":J" & RwCnt + (NxtRw - 1) & "").Value2 = arrOut()
' Ws.Columns("A:J").AutoFit
Rem 5 to remove http://www.eileenslounge.com/viewtopic.php?p=272606&sid=7e8ad1b708dd49a811498ccac6b1e092#p272606 ..... when i click on any cell that has output there is an option numbers stored as text, convert to numbers,help on this error,ignore error,edit in formula bar,error checking options(these are the options coming)
Let Ws.Range("A" & NxtRw & ":J" & RwCnt + (NxtRw - 1) & "").Value2 = Evaluate("=IF(A" & NxtRw & ":J" & RwCnt + (NxtRw - 1) & "="""","""",IF(ISNUMBER(1*A" & NxtRw & ":J" & RwCnt + (NxtRw - 1) & "),1*A" & NxtRw & ":J" & RwCnt + (NxtRw - 1) & ",A" & NxtRw & ":J" & RwCnt + (NxtRw - 1) & "))")
' Let Ws.Range("A" & NxtRw & ":J" & RwCnt + (NxtRw - 1) & "").Value2 = Evaluate("=IF(A" & NxtRw & ":J" & RwCnt + (NxtRw - 1) & "="""","""",IF(ISERROR(1*A" & NxtRw & ":J" & RwCnt + (NxtRw - 1) & "),A" & NxtRw & ":J" & RwCnt & ",1*A" & NxtRw & ":J" & RwCnt + (NxtRw - 1) & "))")
' Let Ws.Range("B" & NxtRw & ":D" & RwCnt + (NxtRw - 1) & "").Value2 = Evaluate("=IF(B" & NxtRw & ":D" & RwCnt + (NxtRw - 1) & "="""","""",IF(ISERROR(1*B" & NxtRw & ":D" & RwCnt + (NxtRw - 1) & "),B" & NxtRw & ":D" & RwCnt & ",1*B" & NxtRw & ":D" & RwCnt + (NxtRw - 1) & "))")

End Sub

_.___________________________


Macro.xlsb : https://app.box.com/s/uwpnuqmnc1uxpl0wpfrbh52iqr1enfcv
NSEVER.txt : https://app.box.com/s/245h7i5nh6an8vw08g8t08fvu30ylih2

[DocAElstein]

In support of this Thread, ( more out of my interests, its totally lost on the OP …. https://excelfox.com/forum/showthread.php/2640-Macro-Correction-converting-data-from-xlsx-to-notepad

As done many times before….
In Notepad
https://imgur.com/eOUaOZv
https://i.imgur.com/eOUaOZv.jpg

Reducing the size , for convenience …
https://imgur.com/FvCn18d
https://i.imgur.com/FvCn18d.jpg

Using a macro we have used many times…

Sub Sept22() ' https://excelfox.com/forum/showthread.php/2640-Macro-Correction-converting-data-from-xlsx-to-notepad https://excelfox.com/forum/showthread.php/2577-Appendix-Thread-(-Codes-for-other-Threads-(-Avinash-)-)?p=14970&viewfull=1#post14970
Dim FileNum As Long: Let FileNum = FreeFile(1) ' https://msdn.microsoft.com/en-us/vba/language-reference-vba/articles/freefile-function
Dim PathAndFileName As String, TotalFile As String
Let PathAndFileName = ThisWorkbook.path & "\" & "AlertExFoxReduced.txt" '
Open PathAndFileName For Binary As #FileNum 'Open Route to data. Binary is a fundemental type data input...
TotalFile = Space(LOF(FileNum)) '....and wot recives it hs to be a string of exactly the right length
Get #FileNum, , TotalFile
Close #FileNum
' What the fuck is in this string?
Call WtchaGot_Unic_NotMuchIfYaChoppedItOff(TotalFile)

End Sub
The macro above gives us:

"NSE" & "," & "15083" & "," & "6" & "," & Chr(62) & "=" & "," & "34300" & "," & "A" & "," & "," & "," & "," & "," & "GTT" & "," & vbLf & "NSE" & "," & "404" & "," & "6" & "," & Chr(62) & "=" & "," & "56700" & "," & "A" & "," & "," & "," & "," & "," & "GTT" & "," & vbLf & "NSE" & "," & "2181" & "," & "6" & "," & Chr(62) & "=" & "," & "1283170" & "," & "A" & "," & "," & "," & "," & "," & "GTT" & "," & vbLf

So we have what looks like a vbLf for the line separator











Share ‘Alert.ExForum.txt’ : https://app.box.com/s/4gn2nlnmnwda8kalp9yugn2j4qvh0891
Share ‘Alert. (1)ExFox.txt’ : https://app.box.com/s/btcb75mogjarlu1o55aq9ncj8x9mx91i