Appendix Thread. ( Codes for other Threads, etc.) Event Coding Drpdown Data validation

[DocAElstein]

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

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

'
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-pro...ml#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 & "
Dim arrTemp() As Variant
 Let arrTemp() = Ws1.Evaluate("transpose(if((j2:j" & LR & "=""buy"")*(h2:h" & 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/showthrea...sx-to-txt-file
https://www.excelfox.com/forum/showt...ge30#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]

So my solution, which I will give in the next post will solve this problem, which is your problem shortened.

_____ Workbook: Autofill.xlsx ( Using Excel 2007 32 bit )

Row\Col	B	C	D	E	F	G
2	S. No.	Alpha Code	Sex	Category	Area
3	1
4	2
5	3

Worksheet: Sheet1
Case1
If I paste or enter A in cell C3, then, automatically put the value…
BOY in cell D3, GEN in cell E3 and URBAN in cell F3
Similarly,
If I paste or enter B in cell C3, then, automatically put the value…
BOY in cell D3, OBC in cell E3 and URBAN in cell F3
Similarly,
As shown in REFERENCE CHART)
the corresponding value should filled in the corresponding cells automatically
Now,
Similarly,
same condition is applied to cell C4, C5, C6 and so on
that is,
If I paste or enter A in cell C4, then, automatically put the value…
BOY in cell D4, GEN in cell E4 and URBAN in cell F4

_____ Workbook: Autofill.xlsx ( Using Excel 2007 32 bit )

Row\Col	R	S	T	U	V	W
1	REFERENCE CHART
2	S. No.	Alpha Code	Sex	Category	Area
3	1	A	BOY	GEN	URBAN
4	2	B	BOY	OBC	URBAN
5	3	C	BOY	SC	URBAN
6	4	D	BOY	ST	URBAN
7	5	E	GIRL	GEN	URBAN

Worksheet: Sheet1

Case2
If I paste or enter BOY in cell D3, GEN in cell E3 and URBAN in cell F3
then, automatically put the value A in cell C3
Similarly,
If I paste or enter BOY in cell D3, OBC in cell E3 and URBAN in cell F3
then, automatically put the value B in cell C3

[DocAElstein]

post to get link for later use...

test


“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.
( !! Sometime when you have been “caught” cross posting, you did not know yourself where you cross posted, and asked to be told. ( Or you maybe only wanted to admit to those where you got “caught”) )
_ 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 very many times, 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 that 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## Some of the major forums may be a good place for you to post.

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 without 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: Your distinguishing characteristic is that you have been making it much more obvious than others doing the same, do: 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, at the major forums.
_ 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 via PM, 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:-
1 Month learn VBA and 1 month getting answers, partly alone, partly with help from forums = Finished Success
2+ Years posting the same and similar questions and just taking the answers = Never Ending Fail
_ It is unlikely that the macros you have that work will ever be very efficient and will likely be slower than anyone else’s: They will certainly not be the best possible. Giving you better coding has proved to be impossible: It is not possible to pass on better codings because of the ridiculously inefficient way that you are organising whatever it is that you are doing: The person receiving and passing on the coding needs to understand the English language and to understand some basic coding and to understand how to use such better coding. We have tried this a few times, but it proved always completely impossible to do. One example of this is the issue of text files: Because you are mostly dealing with values, the use of text files is almost certainly beneficial and in some cases the only efficient way to proceed. You have completely missed the point on this: You have repeated much work to try to avoid using text files. The problem was, and will never be, the issue of text files themselves. The issue is your total inability or unwillingness to understand anything at all about them.

---

##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 will 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.
If you are attempting the personal project that you have told me about via PM, then you are going about it in completely the wrong way.
If you are trying to make a career of posting other people’s questions and getting answers for them, then you should post mostly at the major forums and organise yourself better: At least have access to Excel on a computer and learn the basics of VBA. If you are trying to make a career of posting other people’s questions and getting answers for them, as many people do, then you have made the mistake of making it too obvious. Many of the senior helpers at the main forums prefer to think that they are helping people rather than doing their work for them. What they don’t know, does not hurt them.


I will leave all your posts in the main forum for a few weeks. Then I will move them all to the test forum. I will probably further merge them. Eventually I may delete them all.


Bro, whatever you are trying to do, its not working. Its never going to work. Its just wasting everybody’s time.
You need first to learn English
Then get a computer.
Then learn some basic Excel and Excel VBA
Then start again.



I have not been so impressed with my flower efforts this Summer. I will give Petra the blame for that: Do you remember my great success with the Sun Flowers in the wheelbarrow (https://imgur.com/hF1B4I1 )
Well Petra was not so impressed, she didn’t think it was so nice a wheelbarrow exploding with Sun Flowers, so as a compromise we said we would do it every other year.
But at the end of last year I must have got a few hundred seeds from the flowers. I planted about 100 of them all over the place at the start this year.
It was not a great success, possibly because we have so much shade, almost everywhere. I only noticed 3 growing, 2 still have not got very far. But a combination of intelligence and some nice late Summer sun has got the one up and he is letting everyone see him ….. first it grew about 80cm vertically to get out of the shade, then when it got out in the open it shot up.
https://imgur.com/IRW78eD
https://imgur.com/xKSfRU9
The clever Sun Flower. I must make a point of saving his seeds. ….

[DocAElstein]

Macro for this post
https://excelfox.com/forum/showthrea...ll=1#post14572

_ 4.
This is easy, simply convert the Target.Value to UCase(Target.Value) , and use that converted character in place of Target.Value
( If the Target.Value is already uppercase, then UCase(Target.Value) will not error - Target.Value will just stay as it is )

_ 2. And 3.
This is not difficult, but need s some juggling around with code lines
Two similar code sections are needed

_1. This is a bit more difficult. It is rather unusual not to have a range of the required LookUp information somewhere
This information must come from somewhere.
The most simple solution would be to have that range somewhere
For now , I have put the information on a second worksheet. And made a minor change to the macro to reference that worksheet
If this is not acceptable, then I can put the information somewhere else, such as in the macro itself.

---

So here is my next solution for you.
Once again for now, for clarity and simplicity, I have limited it just to a few rows

Private Sub Worksheet_Change(ByVal Target As Range)
 On Error GoTo Bed
    If Application.Intersect(Target, Me.Range("C3:F5")) Is Nothing Then Exit Sub ' No overlap with the entry range, so exit sub
' Case1
    If Not Application.Intersect(Target, Me.Range("C3:C5")) Is Nothing Then ' Column C entry
    If IsArray(Target.Value) Then Exit Sub ' more than one cell selected, but this procedure can only work on single cell entries in column C
        If Target.Value = "" Then 'This would be a cleared cell ( deleted value )
         Let Application.EnableEvents = False ' This is to prevent the worksheet change in the next code line setting off this procedure again
         Let Target.Offset(0, 1).Resize(1, 3).Value = ""  '   If I delete the Alpha Code from a cell (for example C3), the corresponding range (D3:F3) should be empty/deleted automatically.
         Let Application.EnableEvents = True
        ElseIf Len(Target.Value) <> 1 Then Exit Sub ' we have an entry , but it is invalid
        Else
        End If
    Dim UcsTgtVl As String: Let UcsTgtVl = UCase(Target.Value)
        If InStr(1, ",A,B,C,D,E,", "," & UcsTgtVl & ",", vbBinaryCompare) = 0 Then Exit Sub
        Dim PosS As Long: Let PosS = (InStr(1, ",A,B,C,D,E,", UcsTgtVl, vbBinaryCompare) / 2) + 2 ' Row number in  REFERENCE CHART  for the corrsponding   Sex Category Area values
         Let Application.EnableEvents = False ' This is to prevent the worksheet change in the next code line setting off this procedure again
         Let Target.Offset(0, 1).Resize(1, 3).Value = ThisWorkbook.Worksheets("REFERENCE CHART").Range("T" & PosS & ":V" & PosS & "").Value
         Let Application.EnableEvents = True
' Case2
    ElseIf Not Application.Intersect(Target, Me.Range("D3:F5")) Is Nothing Then ' Entry in column D E or F
        If Target.Columns.Count = 1 Then
            If Target.Value = "" Then 'This would be a cleared cell ( deleted value )
             Let Application.EnableEvents = False ' This is to prevent the worksheet change in the next code line setting off this procedure again
             Let Me.Range("C" & Target.Row & "").Value = ""  '  If I delete any one cell value from the range (for example D3:F3), the corresponding Alpha Code (C3) should be deleted automatically. It means, the Alpha Code should be appear only if all the three cells in the corresponding range (for example D3:F3) are filled. Otherwise, the Alpha Code should be disappear/deleted.
             Let Application.EnableEvents = True
             Exit Sub
            Else
            End If
        ElseIf Target.Rows.Count <> 1 Then Exit Sub ' more than 1 row selected, but this procedure can only work on single row entries
        Else
        End If
    Dim arrSCA() As Variant: Let arrSCA() = Array("BOYGENURBAN", "BOYOBCURBAN", "BOYSCURBAN", "BOYSTURBAN", "GIRLGENURBAN")
    Dim TrgtRw As Long: Let TrgtRw = Target.Row
    Dim DEF As String: Let DEF = Me.Range("D" & TrgtRw).Value & Me.Range("E" & TrgtRw).Value & Me.Range("F" & TrgtRw).Value
    Dim Mtchres As Variant
     Let Mtchres = Application.Match(DEF, arrSCA, 0)
        If IsError(Mtchres) Then Exit Sub ' no matching set of entries in columns D E and F
    Dim PosS2 As Long: Let PosS2 = Mtchres + 2 ' Row number in  REFERENCE CHART  for the corresponding  Alpha Code
     Let Application.EnableEvents = False
     Let Me.Range("C" & TrgtRw & "").Value = Me.Range("S" & PosS2 & "").Value
     Let Application.EnableEvents = True
    Else
    End If
    
Bed: ' just incase anything goes wrong, it is a good idea to make sure that things are turned back to normal
 Let Application.EnableEvents = True
End Sub

---

Share ‘Autofill.xlsm’ : https://app.box.com/s/mt1c2xvdejjj6d3vjo6wkjyrdxrs98tm