+ Reply to Thread
Results 1 to 5 of 5

Please help to fix code to loop through an array instead of a range

  1. #1
    Registered User
    Join Date
    11-07-2016
    Location
    UK
    MS-Off Ver
    2010
    Posts
    11

    Question Please help to fix code to loop through an array instead of a range

    EDIT - I removed my original post content as I found I screwed up on an important issue - thanks to @rorya and for helping me notice my error and to @maniacb for suggesting a solution, which I am not fully sure how too implement.
    I am a copy, paste and edit coder. I cannot write code from a blank page.
    I have managed to get chat.openai to build the following macro for me.
    NO matter what instructions I give chat.openai, it comes back with a range of errors

    The bit I am interested in here is - it correctly looks for a value kw in range results. If <> it copies it to range activeResults
    I want to sped it up by searching an array named resultsAarray instead of results range

    This is the relevant code
    Dim resultsArray As Variant
    ' Define range results, copy to resultsArray
    ' Confirm that resultsArray = results range with 2 x msgBox
    Set results = ws2.Range("F2").Resize(maxRows - 1, resultsCols)
    MsgBox "The size of the results range is: " & results.Rows.count & " rows and " & results.Columns.count & " columns."
    ReDim resultsArray(1 To results.Rows.count, 1 To results.Columns.count)
    ' Copy the values from the results range to the resultsArray
    resultsArray = results.Value
    MsgBox "The size of resultsArray is: " & UBound(resultsArray, 1) & " rows and " & UBound(resultsArray, 2) & " columns."

    ....
    'this is the bit I want to change, so macro searches for kw in resultsArray VS results range
    ' Check if the kw already exists in the "results" range
    For Each cell In results
    If cell.Value = kw Then
    resultExists = True
    Exit For
    End If
    Next cell

    ' Add the keyword and searchCol value to activeResults
    If Not resultExists Then
    ws2.Cells(CopyRow, activeCell.Column).Value = kw
    ws2.Cells(CopyRow, activeCell.Column + 1).Value = ws1.Cells(r, searchCol).Value
    CopyRow = CopyRow + 1
    End If

    Any help would be appreciated



    Full code that works OK with results range
    Sub KWPartial_inColA2xMsg()
    'correctly pops up size of results range and resultsArray
    'still uses results range to update activeResults
    'Was Sub KW_inColA6d() in KWgroupingNEW
    'adds a variable named kw - the value copied to active column
    'adds a range named activeResults
    'deletes values in activeResults
    'adds a range named results
    'checks results to see if kw exists

    ' Declare variables
    Dim ws1 As Worksheet, ws2 As Worksheet
    Dim searchString As Variant, kwCol As Long, searchCol As Long
    Dim r As Long, lastRow As Long, maxRows As Long
    Dim found As Boolean, CopyRow As Long
    Dim searchStringCSV As Variant
    Dim notFoundList As String
    Dim kw As String
    Dim activeResults As Range
    Dim resultsCols As Long
    Dim results As Range
    Dim cell As Range
    Dim kwExists As Boolean, resultExists As Boolean
    ' Assign the value of 50 to resultsCols variable
    resultsCols = 50
    Dim resultsArray As Variant

    ' Set worksheet variables
    Set ws1 = ActiveSheet
    Set ws2 = ActiveSheet

    ' Determine maxRows
    maxRows = WorksheetFunction.Max(ws1.Columns(1).Cells.SpecialCells(xlCellTypeConstants).count, ws2.Columns(1).Cells.SpecialCells(xlCellTypeConstants).count)

    ' Split search string by comma
    If InStr(activeCell.Value, ",") > 0 Then
    searchStringCSV = Split(activeCell.Value, ",")
    Else
    searchStringCSV = Array(activeCell.Value)
    End If

    ' Set column variables
    kwCol = 1
    searchCol = 2

    ' Find last row in column A
    lastRow = ws1.Cells(ws1.Rows.count, kwCol).End(xlUp).row

    ' Initialize CopyRow and notFoundList variables
    CopyRow = activeCell.row + 1
    notFoundList = ""

    ' Define range activeResults
    Set activeResults = ws2.Range(ws2.Cells(2, activeCell.Column), ws2.Cells(lastRow, activeCell.Column + 1))


    ' Delete data in activeResults except for the title row
    If Not activeResults Is Nothing Then
    activeResults.ClearContents
    End If

    ' Define range results
    Set results = ws2.Range("F2").Resize(maxRows - 1, resultsCols)
    MsgBox "The size of the results range is: " & results.Rows.count & " rows and " & results.Columns.count & " columns."
    ReDim resultsArray(1 To results.Rows.count, 1 To results.Columns.count)
    ' Copy the values from the results range to the resultsArray
    resultsArray = results.Value
    MsgBox "The size of resultsArray is: " & UBound(resultsArray, 1) & " rows and " & UBound(resultsArray, 2) & " columns."

    ' Loop through each search string
    For Each searchString In searchStringCSV
    found = False
    searchString = Trim(searchString)
    searchString = UCase(searchString)
    kwExists = False

    ' Loop through each cell in results to check if keyword already exists

    For Each cell In results
    If cell.Value = searchString Then
    kwExists = True
    Exit For
    End If
    Next cell
    ' Only copy if keyword does not exist in results
    If Not kwExists Then
    For r = 2 To lastRow
    If InStr(1, UCase(ws1.Cells(r, kwCol).Value), searchString) > 0 Then
    kw = ws1.Cells(r, kwCol).Value 'Copy the value of Column A to variable kw
    resultExists = False

    ' Check if the kw already exists in the "results" range
    For Each cell In results
    If cell.Value = kw Then
    resultExists = True
    Exit For
    End If
    Next cell

    ' Add the keyword and searchCol value to activeResults
    If Not resultExists Then
    ws2.Cells(CopyRow, activeCell.Column).Value = kw
    ws2.Cells(CopyRow, activeCell.Column + 1).Value = ws1.Cells(r, searchCol).Value
    CopyRow = CopyRow + 1
    End If

    found = True
    End If
    Next r
    End If

    If Not found And Not kwExists Then
    notFoundList = notFoundList & searchString & ", "
    End If
    Next

    If notFoundList <> "" Then
    notFoundList = Left(notFoundList, Len(notFoundList) - 2)
    MsgBox "The searchString(s) '" & notFoundList & "' were not found in Column A."
    End If

    End Sub
    Last edited by colink2; 03-20-2023 at 11:30 AM.

  2. #2
    Forum Expert romperstomper's Avatar
    Join Date
    08-13-2008
    Location
    England
    MS-Off Ver
    365, varying versions/builds
    Posts
    22,051

    Re: Please help to fix code to loop through an array instead of a range

    How/where have you sized resultsArray as an array?
    Everyone who confuses correlation and causation ends up dead.

  3. #3
    Forum Expert
    Join Date
    05-29-2020
    Location
    NH USA
    MS-Off Ver
    365
    Posts
    2,103

    Re: Please help to fix code to loop through an array instead of a range

    I think you can accomplish your end goal more efficiently by using a scripting dictionary as shown below.

    Please Login or Register  to view this content.

  4. #4
    Registered User
    Join Date
    11-07-2016
    Location
    UK
    MS-Off Ver
    2010
    Posts
    11

    Re: Please help to fix code to loop through an array instead of a range

    Thanks for highlighting an issue - current version of code does NOT size resultsArray.

    I have edited my post. Will come back to it once I can accurately describe the issue, or will make a new post

  5. #5
    Registered User
    Join Date
    11-07-2016
    Location
    UK
    MS-Off Ver
    2010
    Posts
    11

    Re: Please help to fix code to loop through an array instead of a range

    Thanks for the suggestion. I realise that I had an error in the version of code I copied from.
    I will consider how to implement your solution and will come back to it once I can accurately describe the issue, or will make a new post

+ Reply to Thread

Thread Information

Users Browsing this Thread

There are currently 1 users browsing this thread. (0 members and 1 guests)

Similar Threads

  1. [SOLVED] convert code from filter to loop with array for big data
    By MKLAQ in forum Excel Programming / VBA / Macros
    Replies: 13
    Last Post: 09-24-2022, 08:01 AM
  2. Loop through Array then Offset Range by given Value
    By rawku123 in forum Excel Programming / VBA / Macros
    Replies: 12
    Last Post: 09-24-2022, 03:54 AM
  3. Two dimentional array code replacement for cell loop
    By Sintek in forum Excel Programming / VBA / Macros
    Replies: 1
    Last Post: 05-02-2018, 05:15 AM
  4. [SOLVED] Help with: Range Array SelectCase Loop delete: Array All Sheet.Names
    By dlow in forum Excel Programming / VBA / Macros
    Replies: 6
    Last Post: 03-08-2015, 07:11 PM
  5. [SOLVED] Simplfy VBA code using Array set & loop
    By Faridwahidi in forum Excel Programming / VBA / Macros
    Replies: 6
    Last Post: 07-08-2014, 11:58 PM
  6. Code to Loop through a 2d array
    By newbi004 in forum Excel Programming / VBA / Macros
    Replies: 11
    Last Post: 12-03-2013, 06:30 AM
  7. [SOLVED] Loading Array: Range vs. Loop
    By cmore in forum Excel Programming / VBA / Macros
    Replies: 11
    Last Post: 10-11-2013, 08:41 PM

Tags for this Thread

Bookmarks

Posting Permissions

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

Search Engine Friendly URLs by vBSEO 3.6.0 RC 1