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

Question 1

Solution for this question, ( 2020-05-28 22:13:09 Rajesh Kumar )
https://excel.tips.net/T002145_Dynam...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/showthrea...ll=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_Dynam...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/thread...value.1135674/

Macros for this post ( Question 1 )
https://excelfox.com/forum/showthrea...ll=1#post13443

Code:

---

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_Dynam...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/thread...value.1135674/

Macro for these posts ( Question 2 )
https://excelfox.com/forum/showthrea...ll=1#post13442
https://excelfox.com/forum/showthrea...ll=1#post13448

Code:

---

'  _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\AllenWyatt\[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

Macros for this post
https://excelfox.com/forum/showthrea...ll=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
4		ANUJ
5		RITA
6		MUKESH
7		RAM
8		RAHIN
9		Anshu
10

Worksheet: Master Sheet

Code:

---

'  _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

Code:

---

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\AllenWyatt\[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

Code:

---

'
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

Code:

---

Option Explicit
Dim LRng As Range

---

---

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

kkfhhfsfhsah

In suppot of this forum post
https://www.excelforum.com/excel-pro...ml#post5340103

Code:

---

'    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

---

In suppot of this forum post
https://excelfox.com/forum/showthrea...sx-to-txt-file
https://www.excelfox.com/forum/showt...ge30#post13348

Code:

---

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

---

lKSHFLhlhfl

lKSHFLhlhfl

lKSHFLhlhfl