How do i populate an Array from another array

[KasperC]

Hello,

I'm having troubles figuring this out.

I have an external Array in a notepad, where there are a Bunch of strings.

I Want to make a new Array from a line from this Array.

Say "Arr(0)" contains the following:1 2 3 4 5 6 7 8
From there I want a new array (lets call it nArr) that can return Arr(1) = 2 (Arr(3) = 4) all the way to the end.

I've tried using a split function, but can't figure out how to make Lbound(SV) To Ubound(SV) a new array.

        FileName = "C:\location\notepad.txt"
        Set FSO = CreateObject("Scripting.FileSystemObject")
        Set MyFile = FSO.OpenTextFile(FileName, 1)
        Arr = Split(MyFile.ReadAll, vbNewLine)

        Dim SV() As String
        SV = Split(Arr(0), " ")

Do I even need to make a new array, or can I use the first Array only?

(I use the external array to store several values split by spaces, and depending on which action in the script I need to perform, I need to return a certain "row" from that array and use that as the "key" for what values I want the script to find in a Range. Ive gotten the deletion part to work perfectly, but I cant figure out how to make the array itself)

Does Anyone have any ideas?

 

[Rick Rothstein]

The Split function always returns an array with a lower bound of zero. If you need to address such an array with index values starting at 1, simply subtract 1 from the index value and use that in the array. For example...

nArr = Split("1 2 3 4 5 6 7 8")
For X = 1 to 8
  MsgBox nArr(X - 1)
Next

 

[KasperC]

The rest of the code (of which i got from kevin9999)

    Dim LRow As Long, i As Long
    Dim a, b, c
    
    LRow = ws.Cells.Find("*", , xlFormulas, , xlByRows, xlPrevious).Row
    a = Range(ws.Cells(2, 1), ws.Cells(LRow, 1)).Resize(, 2)
    ReDim b(1 To UBound(a, 1), 1 To 1)
   
    For i = 1 To UBound(a)
        If Left(a(i, 1), 4) = "2000" And Len(a(i, 1)) > 4 Then b(i, 1) = 1 ' You may ignore this part
        If Not IsError(Application.match(a(i, 2), SV, 0)) Then b(i, 1) = 1
    Next i
   
    ws.Cells(2, 11).Resize(UBound(a)) = b
    i = WorksheetFunction.Sum(ws.Columns(11))
    If i > 0 Then
        ws.Range(ws.Cells(2, 1), ws.Cells(LRow, 11)).Sort Key1:=ws.Cells(2, 11), _
        order1:=xlAscending, Header:=xlNo
        ws.Cells(2, 11).Resize(i).EntireRow.Delete
    End If
    Set a = Nothing
    Set b = Nothing

 

[KasperC]

The Split function always returns an array with a lower bound of zero. If you need to address such an array with index values starting at 1, simply subtract 1 from the index value and use that in the array. For example...

nArr = Split("1 2 3 4 5 6 7 8")
For X = 1 to 8
  MsgBox nArr(X - 1)
Next

Thank you for the reply.

I might have explained myself badly.

I posted the rest of my code in the thread - here I tried to use "SV" in the application.match function, but it does not seem to do what I intend for it to do..

Do you have any tips regarding this?

 

[DanteAmor]

I need to return a certain "row"

Maybe this will help you, because I'm not understanding exactly what you need.

Sub opentxt()
  Dim Filename As String
  Dim FSO As Object, MyFile As Object
  Dim arr As Variant, sv As Variant
  Dim myData As String
  Dim i As Long, j As Long

  Filename = "C:\location\notepad.txt"
  Set FSO = CreateObject("Scripting.FileSystemObject")
  Set MyFile = FSO.OpenTextFile(Filename, 1)
  arr = Split(MyFile.ReadAll, vbNewLine)

  For i = LBound(arr) To UBound(arr)
    sv = Split(arr(i), " ")
    For j = LBound(sv) To UBound(sv)
      myData = sv(j)
      If myData = "some" Then
        MsgBox "The word 'some' is in the row: " & i + 1
        Exit Sub
      End If
    Next
  Next
End Sub

 

[DanteAmor]

I posted the rest of my code in the thread

Still your code is incomplete.

You should put all your code and explain with examples what you have in the file and what you expect as a result.

Everything explained with your words, that way you help us to help you.

 

[KasperC]

Maybe this will help you, because I'm not understanding exactly what you need.

Sub opentxt()
  Dim Filename As String
  Dim FSO As Object, MyFile As Object
  Dim arr As Variant, sv As Variant
  Dim myData As String
  Dim i As Long, j As Long

  Filename = "C:\location\notepad.txt"
  Set FSO = CreateObject("Scripting.FileSystemObject")
  Set MyFile = FSO.OpenTextFile(Filename, 1)
  arr = Split(MyFile.ReadAll, vbNewLine)

  For i = LBound(arr) To UBound(arr)
    sv = Split(arr(i), " ")
    For j = LBound(sv) To UBound(sv)
      myData = sv(j)
      If myData = "some" Then
        MsgBox "The word 'some' is in the row:" & i + 1
        Exit Sub
      End If
    Next
  Next
End Sub

Thank you for the reply and trying to help.

I posted the rest of my code, mabye this brings some clarity of what exactly im trying to do.
I'm trying to "look" for the values in Arr(0) in column 1 and 2, here using a match function - and if it finds that value, mark it in b then deleting further down.

 

[DanteAmor]

I posted the rest of my code

Still your code is incomplete.

Forget your macros, explain with your words and with examples what your goal is.

It is very important that you explain with examples what you have and what you want as a result.

 

[KasperC]

Forget your macros, explain with your words and with examples what your goal is.

It is very important that you explain with examples what you have and what you want as a result.

I got help from User:kevin9999 (also, how do I "link"/give credit to a user?) in this thread to build the following code.
This works perfectly (apart from the filtering further down as discussed in the thread - but I'm sure I'll figure out how to solve that part.

What I need:
- An external Notepad where I can put different strings (each line in the document would look something like this: "3 4 5 53 8" or "1 3 5 8" or "0 1 2") - I've created a userform where I can "choose" what string I want to use.
- These numbers appears in the B column in my dataset from row 2 to LRow, and I want to delete the rows containing any one of the numbers given in the string (In the B column)
- Also I need rows with numbers starting with "2000" over the lenght of 4 in the A column to be deleted.

So the specific question is: how can I make this work As efficiently as possible.
I Was previously looking through with a For function, but this was taking a really long time (code posted in the thread mentioned above).

As you can see, there are then further actions of which I need the script to perform, such as replacing cells in the B column with a letter-number combo depending on what the number is in column B and E. (I also need to make a notepad with the different combinations of B and E numbers and the return letter-number combo, such as 3|133 turns the B-value into "S3". Problem is that these combinations also change depending on what action I need the script to perform - thus making me want to make a notepad with the different combinations, and having the userform return what combinations / "cases" will be needed for any given time I run the script.
I Have not gotten to this part yet - but I believe I can apply the logic of what I need above to this aswell.

More text under code.

Option Explicit
Sub KasperC_V1()
    Dim t As Double: t = Timer
    Application.Calculation = xlManual
    Application.ScreenUpdating = False
   
    'Stage 1 - delete superfluous rows from sheet 1
    Dim ws As Worksheet
    Set ws = Worksheets("Sheet1")       '<~~ *** Change sheet name as required ***
    Dim LRow As Long, i As Long
    Dim a, b, c
    c = Array(0, 1, 4, 9)
    LRow = ws.Cells.Find("*", , xlFormulas, , xlByRows, xlPrevious).Row
    a = Range(ws.Cells(2, 1), ws.Cells(LRow, 1)).Resize(, 2)
    ReDim b(1 To UBound(a, 1), 1 To 1)
  
    For i = 1 To UBound(a)
        If Left(a(i, 1), 4) = "2000" And Len(a(i, 1)) > 4 Then b(i, 1) = 1
        If Not IsError(Application.Match(a(i, 2), c, 0)) Then b(i, 1) = 1
    Next i
  
    ws.Cells(2, 11).Resize(UBound(a)) = b
    i = WorksheetFunction.Sum(ws.Columns(11))
    If i > 0 Then
        ws.Range(ws.Cells(2, 1), ws.Cells(LRow, 11)).Sort Key1:=ws.Cells(2, 11), _
        order1:=xlAscending, Header:=xlNo
        ws.Cells(2, 11).Resize(i).EntireRow.Delete
    End If
    Set a = Nothing
    Set b = Nothing
   
    'Stage 2 - format values starting with 20 or 23 on sheet 1
    Dim ws2 As Worksheet
    Set ws2 = Worksheets("Sheet2")      '<~~ *** Change sheet name as required ***
   
    a = ws.Range("A2", ws.Cells(Rows.Count, "A").End(xlUp))
    ReDim b(1 To UBound(a, 1), 1 To 1)
    Dim s As String
    For i = 1 To UBound(a)
        If Len(a(i, 1)) <= 12 And (Left(a(i, 1), 2) = "20" Or Left(a(i, 1), 2) = "23") Then
            ws2.Range("A2").Value = a(i, 1) & "0000"
            s = CStr("'0" & ws2.Range("A2") & ws2.Range("G2"))
            b(i, 1) = s
        Else
            b(i, 1) = a(i, 1)
        End If
    Next i
    ws.Range("A2").Resize(UBound(b)).Value = b
    ws.Range("A:A").NumberFormat = "@"
    Set a = Nothing
    Set b = Nothing
   
    'Stage 3 - format column B in sheet 1 according to criteria
    a = ws.Range("B2", ws.Cells(Rows.Count, "F").End(xlUp))
    ReDim b(1 To UBound(a, 1), 1 To 1)
   
    For i = 1 To UBound(a)
        s = a(i, 1) & "|" & a(i, 5)
        Select Case s
            Case "3|133"
                b(i, 1) = "S3"
            Case "3|147"
                b(i, 1) = "S3"
            Case "34|342"
                b(i, 1) = "SD"
            Case Else
                b(i, 1) = a(i, 1)
        End Select
    Next i
    ws.Range("B2").Resize(UBound(b)).Value = b
   
    'Stage 4 - copy to sheet 3 if date matches L1
    Dim DtFltr As Long, ws3 As Worksheet
    Set ws3 = Worksheets("Sheet3")          '<~~ *** Change sheet name as required ***
    DtFltr = ws.Range("L1").Value
   
    With ws.Range("A1").CurrentRegion
        .AutoFilter 3, Format(DtFltr, "d/mm/yyyy")
        If ws.Cells(Rows.Count, 1).End(xlUp).Row > 1 Then
            .Offset(1).Resize(.Rows.Count - 1, 4).Copy ws3.Range("E2")
        End If
        .AutoFilter
    End With
   
    Application.Calculation = xlAutomatic
    Application.ScreenUpdating = True
    MsgBox Timer - t & " seconds"
End Sub

From there I added the part of turning the notepad document into a readable Array:

        FileName = "C:\location\notepad.txt"
        Set FSO = CreateObject("Scripting.FileSystemObject")
        Set MyFile = FSO.OpenTextFile(FileName, 1)
        Arr = Split(MyFile.ReadAll, vbNewLine)

        Dim SV() As String
        SV = Split(Arr(0), " ")

From here I tried replacing "c" in "part1" of the code, without any luck. This is in practice what I need - to replace the "c" Array/string with i.e. the "Arr(0)" values.

Hope that was understandeble.

 

[KasperC]

Solved the issiue.

What I needed to do was to convert the a(i, 1) range to a string - then the Match function had no problem working with the exsisting array.