Set keywords in VBA based on multiple columns with dynamic ranges - vba

Question

I need to set some keywords based on multiple columns. I currently use this code which works well for one column:
Dim Words As range
Set Words = Sheets("Words").range("A2").Resize(Sheets("Words").range("A" & Rows.Count).End(xlUp).Row - 1)
But if I extend this to, say, A:AT it doesn't work.
Basically all I want to do is store all the words in ranges A2:Ax all the way to AT2:ATx but the issue is that each column has a different number of words that need to be stored.
EDIT: As requested, my full code as it currently stands
Sub Keyword()
Application.ScreenUpdating = False
Dim Words As range
Dim strText As range
Dim c As range
Dim r As range
Set Words = Sheets("Words").range("A2:AT2").Resize(Sheets("Words").range("A" & Rows.Count).End(xlUp).Row - 1)
Set strText = Sheets("Verbatims").range("BJ2").Resize(Sheets("Verbatims").range("BJ" & Rows.Count).End(xlUp).Row - 1)
For Each c In strText
For Each r In Words
If InStr(1, UCase(c), UCase(r), 1) > 0 Then
c.Offset(, 29) = c.Offset(, 29) & ", " & r
End If
Next r
If Len(c.Offset(, 29)) > 0 Then c.Offset(, 29) = Right(c.Offset(, 29), (Len(c.Offset(, 29)) - 2))
Next c
Application.ScreenUpdating = True
End Sub
EDIT2: Thanks to #jamheadart I've updated my code and it works now.
Sub Keywords()
Dim WordsRange As range
Dim hRow As Long
Dim i As Long
With Worksheets("Words")
For i = 1 To 46
If hRow < Cells(Rows.Count, i).End(xlUp).Row Then hRow = Cells(Rows.Count, i).End(xlUp).Row
Next i
Set WordsRange = range("A2:AT" & hRow)
End With
Dim c As range
Dim Words As Collection
Set Words = New Collection
For Each c In WordsRange
If c.Value <> "" Then Words.Add c.Value
Next
Dim strText As range
Dim x As range
Dim r As Variant
Set strText = Sheets("Verbatims").range("BJ2").Resize(Sheets("Verbatims").range("BJ" & Rows.Count).End(xlUp).Row - 1)
For Each x In strText
For Each r In Words
If InStr(1, UCase(x), UCase(r), 1) > 0 Then
x.Offset(, 29) = x.Offset(, 29) & ", " & r
End If
Next r
If Len(x.Offset(, 29)) > 0 Then x.Offset(, 29) = Right(x.Offset(, 29), (Len(x.Offset(, 29)) - 2))
Next x
End Sub

Answer 1

I think you need to loop through columns 1 to 46 (AT) and find the maximum row, I wouldn't normally rely on UsedRange because it can sometimes not register updates on sheets but I suspect you aren't writing a massive long thread.
Sub eh()
Dim WordsRange As Range
Dim hRow As Long
Dim i As Long
For i = 1 To 46
If hRow < Cells(Rows.Count, i).End(xlUp).Row Then hRow = Cells(Rows.Count, i).End(xlUp).Row
Next i
Set WordsRange = Range("A2:AT" & hRow)
MsgBox (WordsRange.Address)
End Sub
Maybes you then want to put everything that's not a "" in to a list of key words to check against rather than checking against the range?
Dim c as Range
Dim Words as Collection
For Each c In WordsRange
If c.Value2 <> "" Then Words.Add c.Value2
Next

Answer 2

may be you're after this
Dim Words As Range
With Worksheets("Words")
With Intersect(.Range("A:AT"), .UsedRange)
Set Words = .Resize(.Rows.Count - 1).Offset(1, 0).SpecialCells(xlCellTypeConstants)
End With
End With

Answer 3

Try,
Dim Words As range
with workSheets("Words")
with intersect(.range("A:AT"), .usedrange)
Set Words = .resize(.rows.count-1, .columns.count).offset(1, 0)
end with
end with
If you want to avoid blanks, create a Union.
Dim Words As range, i as long
with workSheets("Words")
set words = .range(.cells(2, "A"), .cells(.rows.count, "A").end(xlup))
for i=2 to .columns("AT").column
set words = Union(words, .range(.cells(2, i), .cells(.rows.count, i).end(xlup))
next i
end with
To cycle through that Union you will likely have to deal with the Range.Areas property.