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
Bookmarks