Page 32 of 54 FirstFirst ... 22303132333442 ... LastLast
Results 311 to 320 of 538

Thread: Appendix Thread. 3 TEST COPY

  1. #311
    Fuhrer, Vierte Reich DocAElstein's Avatar
    Join Date
    Aug 2014
    Posts
    9,479
    Rep Power
    10
    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

  2. #312
    Fuhrer, Vierte Reich DocAElstein's Avatar
    Join Date
    Aug 2014
    Posts
    9,479
    Rep Power
    10
    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

  3. #313
    Fuhrer, Vierte Reich DocAElstein's Avatar
    Join Date
    Aug 2014
    Posts
    9,479
    Rep Power
    10
    kkfhhfsfhsah

  4. #314
    Fuhrer, Vierte Reich DocAElstein's Avatar
    Join Date
    Aug 2014
    Posts
    9,479
    Rep Power
    10
    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 & "
    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

  5. #315
    Fuhrer, Vierte Reich DocAElstein's Avatar
    Join Date
    Aug 2014
    Posts
    9,479
    Rep Power
    10
    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
    '

  6. #316
    Fuhrer, Vierte Reich DocAElstein's Avatar
    Join Date
    Aug 2014
    Posts
    9,479
    Rep Power
    10
    lKSHFLhlhfl

  7. #317
    Fuhrer, Vierte Reich DocAElstein's Avatar
    Join Date
    Aug 2014
    Posts
    9,479
    Rep Power
    10
    lKSHFLhlhfl

  8. #318
    Fuhrer, Vierte Reich DocAElstein's Avatar
    Join Date
    Aug 2014
    Posts
    9,479
    Rep Power
    10
    lKSHFLhlhfl

  9. #319
    Fuhrer, Vierte Reich DocAElstein's Avatar
    Join Date
    Aug 2014
    Posts
    9,479
    Rep Power
    10
    test ...


    test

    skjfSKJHFkjhfKJSHFSKJHFskjhf

    Different File Types used for simple values
    See here ( This post https://excelfox.com/forum/showthrea...ge30#post13349 )
    for typical comparisons of text Files, Excel files, and data files
    Text File: https://excelfox.com/forum/showthrea...ll=1#post13693
    Excel File: https://excelfox.com/forum/showthrea...ll=1#post13694
    Data File: https://excelfox.com/forum/showthrea...ll=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/showthrea...ll=1#post13717

    It is a function.
    So you will need to call it with a test macro such as this:
    Code:
    ' 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\Col A B C D E F G H I J K L
    1 NSE 101010 6 < 12783 A GTT
    2 NSE 22 6 < 12783 A GTT
    3 NSE 17388 6 < 12783 A GTT
    4
    Worksheet: Sheet1



  10. #320
    Fuhrer, Vierte Reich DocAElstein's Avatar
    Join Date
    Aug 2014
    Posts
    9,479
    Rep Power
    10
    lKSHFLhlhfl

Similar Threads

  1. Replies: 189
    Last Post: 02-06-2025, 02:53 PM
  2. Replies: 539
    Last Post: 04-24-2023, 04:23 PM
  3. Appendix Thread. 3 *
    By DocAElstein in forum Test Area
    Replies: 540
    Last Post: 04-24-2023, 04:23 PM
  4. Replies: 293
    Last Post: 09-24-2020, 01:53 AM
  5. Appendix Thread. Diet Protokol Coding Adaptions
    By DocAElstein in forum Test Area
    Replies: 6
    Last Post: 09-05-2019, 10:45 AM

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •