EXCEL VBA , Search Line Error 1004 - vba

I am trying to run an excel vba form to search through the lines, but for some unknown reason I get the error:
Method Range of object Global failed
Private Sub CommandButton3_Click()
Dim last, i As Integer
Dim ref, lote As String
'Sheets("analisegeral").Visible = True
Sheets("analisegeral").Select
last = Range("analisegeral").End(xlUp).Row + 1
For i = 2 To last ref = Cells(i, 8)
lote = Cells(i, 13)
If TextBox1.Text = ref Then
TextBox2.Text = lote
GoTo fim
End If
Next i
If TextBox1.Text <> ref Then
TextBox2.Text = ""
MsgBox "Referência não encontrada!", vbInformation
TextBox1.Text = ""
TextBox2.Text = ""
GoTo fim
End If
fim:
End Sub

There are few issues with your code.
Invalid declaration
Dim last, i As Integer
Dim ref, lote As String
Note that last and ref are declared as Variant type here, unless it was your intent, change it to following:
Dim last As Integer, i As Integer
Dim ref As String, lote As String
Failing to activate worksheet where range is located
'Sheets("analisegeral").Visible = True
Sheets("analisegeral").Select
The fact that your sheet is hidden (or very hidden) disallows it's selection.
Probably this is the case of your error.
Wrong method of calculating last row number
last = Range("analisegeral").End(xlUp).Row + 1
Given you will actualy select analisegeral sheet, this still doesn't make sense:
Range("NamedRange") is a construction that allows to refer to previously named range (either with VBA or manualy). Unless you have one, this will raise another error. Perhaps you meant something like this?
last = Range("A" & Rows.Count).End(xlUp).Row
This will give you a number of column A last row.
Final advice: avoid using Select

Related

Simple cipher in VBA in Excel using a table for substitution

I want to write a simple cipher in Excel which would take a text from a cell, substitute each letter for a number from adjacent column and then put the output in another cell. Can't get VLOOKUP to work - it works as a formula, but somehow can't get it to work inside VBA code. Tried to do a simple procedure first that would do this for one character (adding a loop later would be easy), but it doesn't work. It compiles, but when I run it (press a button I assigned it to) I get "#N/A" in the result cell.
Sub Zakoduj()
Dim Literka As String
Dim Liczba As Variant
Dim ColumnToTake As Integer
ColumnToTake = 1 ' Liczby
On Error Resume Next
Err.Clear
Literka = Sheets("Sheet2").Range("B2").Value
Liczba = Application.VLookup(Literka, Sheets("Sheet1").Range("A5:B39"), ColumnToTake, False)
If Err.Number = 0 Then
Sheet2.Range("B6").Value = Liczba
Else
Sheet2.Range("B6").Value = Err.Number
End If
End Sub
The range contains number and characters as follows:
Kod Litera
16 A
73 B
12 C
40 D
70 E
etc. etc.
Couldn't find a tutorial that would explain how to do this...
Here is a modified version. Note that the values are in A1:B6 on sheet 1
Option Explicit
Sub Zakoduj()
Dim Literka As Integer
Dim Liczba As String
Dim ColumnToTake As Integer
ColumnToTake = 2 ' Liczby
Literka = Sheets("Sheet2").Range("B2").Value
Liczba = "Value not found" 'If value is not found
On Error Resume Next
Liczba = Application.WorksheetFunction.VLookup(Literka, Sheets("Sheet1").Range("A1:B6"), ColumnToTake, False)
On Error GoTo 0 'Always reset error handling after On Error Resume Next
Sheet2.Range("B6").Value = Liczba
End Sub

Perfect user input validation in Excel VBA

I need to validate user input on when cells change and show the error in another cell in Excel using VBA.
I run into problems where my validator is called on all cells in the sheet when a user inserts rows or column which makes Excel unresponsive for a long time, how can I fix this?
Below are my requirements and my current solution with full documentation.
Definition and requirements
Consider the following table:
Example User Input Table
| | | Tolerance | | |
| Type | Length | enabled | Tolerance | Note |
|------|--------|-----------|-----------|----------------------------|
| | 4 | 0 | | Type is missing |
| | | 0 | | Type is missing |
| C | 40 | 1 | 110 | |
| D | 50 | 1 | | Tolerance is missing |
| | | | | |
The idea is that the user inputs values in the table, once a value has been changed (the user leaves the cell) the value is validated and if there is a problem the error is printed in the Note column.
Blank lines should be ignored.
I need this to be robust meaning it should not fail on any user input, that means it has to work for the following cases:
Paste values
Delete rows
Insert rows (empty or cut cells)
Insert/delete columns *
Any other case I missed thinking about?
*It is OK if the the validation fails when a user is deleting a column that is part of the table as this is seen as the user willfully vandalizing the sheet, but it has to fail gracefully (i.e. not by validating all cells in the worksheet which takes a long time). It would have been great if this action was undoable, however my current understanding of Excel suggests this is impossible (after a macro has changed something in the sheet, nothing can be undone anymore).
The Note cell can only contain one error at a time, for the user the most relevant error is the one for the cell the user last changed, so it should display this error first. After the user fixes that error the order is not that important anymore, so it could just display the errors from left to right.
Problems with current approach
My problem is that when rows/columns are inserted validation is triggered for all cells in the sheet which is a very slow process and to the user it looks like the program has crashed, but it will return once the validation is complete.
I don't know why Excel does this but I need a way to work around it.
Code placed in a Sheet named 'User Input'
My solution is based on the only on change event handler I know of: the per sheet global Worksheet_Change function (ugh!).
Worksheet_Change function
First it checks if the changed cell(s) intersects with the cells I'm interested in validating. This check is actually quite fast.
OldRowCount here is a try to catch the user inserting or deleting cells depending on how the used range changes, however this only solves some cases and introduces problems whenever Excel forgets the global variable (which happens now and then for as to me unknown reasons) as well as the first time the function is run.
The for loop makes it work for pasted values.
Option Explicit
Public OldRowCount As Long
' Run every time something is changed in the User Input sheet, it then filters on actions in the table
Private Sub Worksheet_Change(ByVal Target As Range)
Dim NewRowCount As Long
NewRowCount = ActiveSheet.UsedRange.Rows.count
If OldRowCount = NewRowCount Then
If Not Intersect(Target, Me.Range(COL_TYPE & ":" & COL_TOLERANCE)) Is Nothing Then
Dim myCell As Range
' This loop makes it work if multiple cells are changed, for example while pasting cells
For Each myCell In Target.Cells
' Protect the header rows
If myCell.row >= ROW_FIRST Then
checkInput_cell myCell.row, myCell.Column, Me
End If
Next
End If
ElseIf OldRowCount > NewRowCount Then
'Row deleted, won't have to deal with this as it solves itself
OldRowCount = NewRowCount
ElseIf OldRowCount < NewRowCount Then
Debug.Print "Row added, TODO: deal with this"
OldRowCount = NewRowCount
End If
End Sub
Code placed in a module
Global variables
Defines the rows/columns to be validated.
Option Explicit
' User input sheet set up
Public Const ROW_FIRST = 8
Public Const COL_TYPE = "B"
Public Const COL_LENGTH = "C"
Public Const COL_TOLERANCE_ENABLED = "D"
Public Const COL_TOLERANCE = "E"
Public Const COL_NOTE = "G"
Cell checking function
This function validates the given cell unless the row where the cell is is empty.
Meaning we are only interested in validating cells on rows where the user has actually started giving values. Blank rows is not a problem.
It first validates the currently changed cell, if it is OK it will then validate the other cells on the given row (since some cells validation depends the values of other cells, see Tolerance enabled in my example table above).
The note will only ever contain one error message at a time, the above is done so that we always get the error of the last changed cell in the Note cell.
Yes, this will make the checker run twice on the current cell, while it is not a problem it could be avoided by a more complex if statement, but for simplicity I skipped it.
Sub checkInput_cell(thisRow As Long, thisCol As Long, sheet As Worksheet)
Dim note As String
note = ""
With sheet
' Ignore blank lines
If .Range(COL_TYPE & thisRow).value <> "" _
Or .Range(COL_LENGTH & thisRow).value <> "" _
Or .Range(COL_TOLERANCE_ENABLED & thisRow).value <> "" _
Or .Range(COL_TOLERANCE & thisRow).value <> "" _
Then
' First check the column the user changed
If col2Let(thisCol) = COL_TYPE Then
note = check_type(thisRow, sheet)
ElseIf col2Let(thisCol) = COL_LENGTH Then
note = check_length(thisRow, sheet)
ElseIf col2Let(thisCol) = COL_TOLERANCE_ENABLED Then
note = check_tolerance_enabled(thisRow, sheet)
ElseIf col2Let(thisCol) = COL_TOLERANCE Then
note = check_tolerance(thisRow, sheet)
End If
' If that did not result in an error, check the others
If note = "" Then note = check_type(thisRow, sheet)
If note = "" Then note = check_length(thisRow, sheet)
If note = "" Then note = check_tolerance_enabled(thisRow, sheet)
If note = "" Then note = check_tolerance(thisRow, sheet)
End If
' Set note string (done outside the if blank lines checker so that it will reset the note to nothing on blank lines)
' only change it actually set it if it has changed (optimization)
If Not .Range(COL_NOTE & thisRow).value = note Then
.Range(COL_NOTE & thisRow).value = note
End If
End With
End Sub
Validators for individual columns
These functions takes a row and validate the a certain column according to it's special requirements. Returns a string if the validation fails.
' Makes sure that type is :
' Unique in its column
' Not empty
Function check_type(affectedRow As Long, sheet As Worksheet) As String
Dim value As String
Dim duplicate_found As Boolean
Dim lastRow As Long
Dim i As Long
duplicate_found = False
value = sheet.Range(COL_TYPE & affectedRow).value
check_type = ""
' Empty value check
If value = "" Then
check_type = "Type is missing"
Else
' Check for uniqueness
lastRow = sheet.Range(COL_TYPE & sheet.Rows.count).End(xlUp).row
If lastRow > ROW_FIRST Then
For i = ROW_FIRST To lastRow
If Not i = affectedRow And sheet.Range(COL_TYPE & i).value = value Then
duplicate_found = True
End If
Next
End If
If duplicate_found Then
check_type = "Type has to be unique"
Else
' OK
End If
End If
End Function
' Makes sure that length is a whole number larger than -1
Function check_length(affectedRow As Long, sheet As Worksheet) As String
Dim value As String
value = sheet.Range(COL_LENGTH & affectedRow).value
check_length = ""
If value = "" Then
check_length = "Length is missing"
ElseIf IsNumeric(value) Then
If Not Int(value) = value Then
check_length = "Length cannot be decimal"
ElseIf value < 0 Then
check_length = "Length is below 0"
ElseIf InStr(1, value, ".") > 0 Then
check_length = "Length contains a dot"
Else
' OK
End If
ElseIf Not IsNumeric(value) Then
check_length = "Length is not a number"
End If
End Function
' Makes sure that tolerance enabled is either 1 or 0:
Function check_tolerance_enabled(affectedRow As Long, sheet As Worksheet) As String
Dim value As String
value = sheet.Range(COL_TOLERANCE_ENABLED & affectedRow).value
check_tolerance_enabled = ""
If Not value = "0" And Not value = "1" Then
check_tolerance_enabled = "Tolerance enabled has to be 1 or 0"
Else
' OK
End If
End Function
' Makes sure that tolerance is a whole number larger than -1
' But only checks tolerance if it is enabled in the tolerance enabled column
Function check_tolerance(affectedRow As Long, sheet As Worksheet) As String
Dim value As String
value = sheet.Range(COL_TOLERANCE & affectedRow).value
check_tolerance = ""
If value = "" Then
If sheet.Range(COL_TOLERANCE_ENABLED & affectedRow).value = 1 Then
check_tolerance = "Tolerance is missing"
End If
ElseIf IsNumeric(value) Then
If Not Int(value) = value Then
check_tolerance = "Tolerance cannot be decimal"
ElseIf value < 0 Then
check_tolerance = "Tolerance is below 0"
ElseIf InStr(1, value, ".") > 0 Then
check_tolerance = "Tolerance contains a dot"
Else
' OK
End If
ElseIf Not IsNumeric(value) Then
check_tolerance = "Tolerance is not a number"
End If
End Function
Addressing support functions
These functions translates a letter to a column and vice versa.
Function let2Col(colStr As String) As Long
let2Col = Range(colStr & 1).Column
End Function
Function col2Let(iCol As Long) As String
Dim iAlpha As Long
Dim iRemainder As Long
iAlpha = Int(iCol / 27)
iRemainder = iCol - (iAlpha * 26)
If iAlpha > 0 Then
col2Let = Chr(iAlpha + 64)
End If
If iRemainder > 0 Then
col2Let = col2Let & Chr(iRemainder + 64)
End If
End Function
Code is tested on/has to work for Excel 2010 and onwards.
Edited for clarity
Finally got it working
After quite a bit of more agonizing, it turned out the fix was quite easy.
I added a new test that checks if the area that the user changed (the Target Range) consists of a column by looking at the address of the Range, if it is a full column the checker will ignore it. This solves the problem where the validation hogs Excel for about one minute.
The result of the intersection calculation is used for the inner loop which limits checks to cells within the area we are interested in validating.
Fixed Worksheet_Change function
Option Explicit
' Run every time something is changed in the User Input sheet
Private Sub Worksheet_Change(ByVal Target As Range)
Dim InterestingRange As Range
Set InterestingRange = Intersect(Target, Me.Range(COL_TYPE & ":" & COL_TOLERANCE))
If Not InterestingRange Is Nothing Then
' Guard against validating every cell in an inserted column
If Not RangeAddressRepresentsColumn(InterestingRange.address) Then
Dim myCell As Range
' This loop makes it work if multiple cells are changed,
' for example when pasting cells
For Each myCell In InterestingRange.Cells
' Protect the header rows
If myCell.row >= ROW_FIRST Then
checkInput_cell myCell.row, myCell.Column, Me
End If
Next
End If
End If
End Sub
New support function
' Takes an address string as input and determines if it represents a full column
' A full column is on the form $A:$A for single or $A:$C for multiple columns
' The unique characteristic of a column address is that it has always two
' dollar signs and one colon
Public Function RangeAddressRepresentsColumn(address As String) As Integer
Dim dollarSignCount As Integer
Dim hasColon As Boolean
Dim Counter As Integer
hasColon = False
dollarSignCount = 0
' Loop through each character in the string
For Counter = 1 To Len(address)
If Mid(address, Counter, 1) = "$" Then
dollarSignCount = dollarSignCount + 1
ElseIf Mid(address, Counter, 1) = ":" Then
hasColon = True
End If
Next
If hasColon And dollarSignCount = 2 Then
RangeAddressRepresentsColumn = True
Else
RangeAddressRepresentsColumn = False
End If
End Function

Skip iteration of loop if certain value exists

I have the following code below that iterates through rows of a specific range and if a value is present (code not seen), creates copies of the entire pages. My concern is at the bottom of the code in the iteration of r1. It originally only had one conditional statement...
If BiDiRowValid(r1)
and I wanted to add a second conditional statement, which I did...
and Range("MAIN_BIDI_PINMC") <> "No BiDi"
but when I run the code and the MAIN_BIDI_PINMC range = "No BiDi", it errors out and doesn't get past that line. FYI: IsBiDiRowValid() is a function that checks to see that the specific r1 is not empty, and then continues. Right after that subroutine finishes and exits, my code errors with a "Type Mismatch error". I also added the ElseIf line at the bottom, I have not gotten to that code because the top errors out, but I just want to make sure I am writing this iteration correctly, and if anything else needs to be done. Basically, if "NoBiDi" is found in the range, I want it to skip all of this code and go to the next r1... which is what I think I have written... Thanks in advance!
Private Sub start_new()
Dim MC_List As Range
Dim r1 As Range
Dim biDiPinName As Range
Dim Pin As String
Dim mc As String
Dim mType As String
Dim tabName As String
Dim rowNumber As Integer
Dim pinmcSplit() As String
Dim NoBidi As String
On Error GoTo start_biDi_tr_new_Error
Set MC_List = Range("MAIN_PINMC_TABLE")
Set biDiPinName = Range("MAIN_PIN2_NAME")
For Each r1 In MC_List.Rows
If IsBiDiRowValid(r1) And WorksheetFunction.CountIf(Worksheets("MAIN").Range("MAIN_BIDI_PINMC", "No Bidi") = 0 Then
tabName = r1.Cells(1, 8)
pinmcSplit = Split(tabName, "_")
Pin = pinmcSplit(0)
mc = pinmcSplit(1)
mType = r1.Cells(1, 3)
ElseIf WorksheetFunction.CountIf(Worksheets("MAIN").Range("MAIN_BIDI_PINMC"), "No Bidi") = 1 Then
End If
Next
You are getting that error because Range("MAIN_BIDI_PINMC") is not a single cell. To check for a value in multiple cells you can use Application.Worksheetfunction.Countif
EDIT
Post discussion in chat, the user wanted to loop through each cell.
Dim aCell As Range
For Each r1 In MC_List.Rows
If IsBiDiRowValid(r1) Then
For Each aCell In Worksheets("MAIN").Range("MAIN_BIDI_PINMC")
If aCell.Value <> "No Bidi" Then
tabName = r1.Cells(1, 8)
pinmcSplit = Split(tabName, "_")
Pin = pinmcSplit(0)
mc = pinmcSplit(1)
mType = r1.Cells(1, 3)
End If
Next
ElseIf aCell.Value = "No Bidi" Then
'~~> Do Something
End If
Next

Run-time error "13": in my VBA excel code

I'm writing a script that will count a numbers of days between few separate dates. I have a data in cell like:
1-In Progress#02-ASSIGNED TO TEAM#22/01/2013 14:54:23,4-On
Hold#02-ASSIGNED TO TEAM#18/01/2013 16:02:03,1-In Progress#02-ASSIGNED
TO TEAM#18/01/2013 16:02:03
That's the info about my transaction status. I want to count the numbers of days that this transaction was in "4-On Hold". So in this example it will be between 18/01/2013 and 22/01/2013.
I wrote something like this(sorry for ma native language words in text)
Sub Aktywnywiersz()
Dim wiersz, i, licz As Integer
Dim tekstwsadowy As String
Dim koniectekstu As String
Dim pozostalytekst As String
Dim dataztekstu As Date
Dim status4jest As Boolean
Dim status4byl As Boolean
Dim datarozpoczecia4 As Date
Dim datazakonczenia4 As Date
Dim dniw4 As Long
wiersz = 2 'I start my scrypt from second row of excel
Do Until IsEmpty(Cells(wiersz, "A")) 'this should work until there is any text in a row
status4jest = False 'is status 4-On Hold is now in a Loop
status4byl = False 'is status 4-On Hold was in las loop
dniw4 = 0 ' numbers od days in 4-On Hold status
tekstwsadowy = Cells(wiersz, "H").Value2 'grabing text
tekstwsadowy = dodanieprzecinka(tekstwsadowy) 'in some examples I had to add a coma at the end of text
For i = 1 To Len(tekstwsadowy)
If Right(Left(tekstwsadowy, i), 1) = "," Then licz = licz + 1 'count the number of comas in text that separates the changes in status
Next
For j = 1 To licz
koniectekstu = funkcjaliczeniadni(tekstwsadowy) 'take last record after coma
Cells(wiersz, "k") = koniectekstu
dataztekstu = funkcjadataztekstu(koniectekstu) 'take the date from this record
Cells(wiersz, "m") = dataztekstu
status4jest = funkcjaokreslenia4(koniectekstu) 'check if there is 4-On Hold in record
Cells(wiersz, "n") = status4jest
If (status4byl = False And staus4jest = True) Then
datarozpoczecia4 = dataztekstu
status4byl = True
ElseIf (status4byl = True And staus4jest = False) Then
datazakonczenia4 = dataztekstu
status4byl = False 'if elseif funkcion to check information about 4-On Hold
dniw4 = funkcjaobliczeniadniw4(dniw4, datazakonczenia4, datarozpoczecia4) 'count days in 4-On Hold
Else
'Else not needed...
End If
tekstwsadowy = resztatekstu(tekstwsadowy, koniectekstu) 'remove last record from main text
Next
Cells(wiersz, "L") = dniw4 ' show number of days in 4-On Hold status
wiersz = wiersz + 1
Loop
End Sub
Function funkcjaliczeniadni(tekstwsadowy As String)
Dim a, dl As Integer
dl = Len(tekstwsadowy)
a = 0
On Error GoTo errhandler:
Do Until a > dl
a = Application.WorksheetFunction.Find(",", tekstwsadowy, a + 1)
Loop
funkcjaliczeniadni = tekstwsadowy
Exit Function
errhandler:
funkcjaliczeniadni = Right(tekstwsadowy, dl - a)
End Function
Function dodanieprzecinka(tekstwsadowy As String)
If Right(tekstwsadowy, 1) = "," Then
dodanieprzecinka = Left(tekstwsadowy, Len(tekstwsadowy) - 1)
Else
dodanieprzecinka = tekstwsadowy
End If
End Function
Function resztatekstu(tekstwsadowy, koniectekstu As String)
resztatekstu = Left(tekstwsadowy, Len(tekstwsadowy) - Len(koniectekstu))
End Function
Function funkcjadataztekstu(koniectekstu As String)
funkcjadataztekstu = Right(koniectekstu, 19)
funkcjadataztekstu = Left(funkcjadataztekstu, 10)
End Function
Function funkcjaobliczeniadniw4(dniw4 As Long, datazakonczenia4 As Date, datarozpoczecia4 As Date)
Dim liczbadni As Integer
liczbadni = DateDiff(d, datarozpoczecia4, datazakonczenia4)
funkcjaobliczaniadniw4 = dniw4 + liczbadni
End Function
Function funkcjaokreslenia4(koniectekstu As String)
Dim pierwszyznak As String
pierwszyznak = "4"
If pierszyznak Like Left(koniectekstu, 1) Then
funkcjaokreslenia4 = True
Else
funkcjaokreslenia4 = False
End If
End Function
And for now I get
Run-time error "13"
in
dataztekstu = funkcjadataztekstu(koniectekstu) 'take the date from this record
I would be very grateful for any help.
You are getting that error because of Type Mismatch. dataztekstu is declared as a date and most probably the expression which is being returned by the function funkcjadataztekstu is not a date. You will have to step through it to find what value you are getting in return.
Here is a simple example to replicate that problem
This will give you that error
Option Explicit
Sub Sample()
Dim dt As String
Dim D As Date
dt = "Blah Blah"
D = getdate(dt)
Debug.Print D
End Sub
Function getdate(dd As String)
getdate = dd
End Function
This won't
Option Explicit
Sub Sample()
Dim dt As String
Dim D As Date
dt = "12/12/2014"
D = getdate(dt)
Debug.Print D
End Sub
Function getdate(dd As String)
getdate = dd
End Function
If you change your function to this
Function funkcjadataztekstu(koniectekstu As String)
Dim temp As String
temp = Right(koniectekstu, 19)
temp = Left(temp, 10)
MsgBox temp '<~~ This will tell you if you are getting a valid date in return
funkcjadataztekstu = temp
End Function
Then you can see what that function is returning.
I tried running your code, but it is a little difficult to understand just what it is that you want to do. Part of it is the code in your language, but the code is also hard to read beacuse of the lack of indentation etc. :)
Also, I do not understand how the data in the worksheet looks. I did get it running by guessing, though, and when I did I got the same error you are describing on the second run of the For loop - that was because the koniectekstu string was empty. Not sure if this is your problem, so my solution is a very general.
In order to solve this type of problem:
Use Option Explicit at the top of your code module. This will make you have to declare all variables used in the module, and you will remove many of the problems you have before you run the code. Eg you are declaring a variable status4jest but using a different variable called staus4jest and Excel will not complain unless you use Option Explicit.
Declare return types for your functions.
Format your code so it will be easier to read. Use space before and after statements. Comment everything! You have done some, but make sure a beginner can understand. I will edit you code as an example of indentation.
Debug! Step through your code using F8 and make sure all variables contain what you think they do. You will most likely solve your problem by debugging the code this way.
Ask for help here on specific problems you run into or how to solve specific problems, do not send all the code and ask why it is not working. If you break down your problems into parts and ask separately, you will learn VBA yourself a lot faster.
A specific tip regarding your code: look up the Split function. It can take a string and make an array based on a delimiter - Example: Split(tekstwsadowy, ",") will give you an array of strings, with the text between the commas.
Did I mention Option Explicit? ;)
Anyway, I hope this helps, even if I did not solve the exact error you are getting.

VBA Runtime Error 9: Subscript out of range

I have been trying to write a small piece of code to validate to confirm whether or not a date is included in an array. I have been able to scroll through the code until I reach the line If lists(i) = TodaysDate Then when the lists(i) show subscript out of range. I have searched through the Internet and I'm unable to resolve this issue.
My Macro reads as follows:
Sub size_an_array()
Dim i As Integer
Dim Range_of_Dates As Integer
Dim TodaysDate As Variant, finish As String
TodaysDate = Range("Sheet11!c2")
ThisWorkbook.Worksheets("Sheet11").Activate
lists = Range("Processed_Dates")
Range_of_Dates = UBound(lists, 1) - LBound(lists, 1) + 1
For c = 1 To UBound(lists, 1) ' First array dimension is rows.
For R = 1 To UBound(lists, 2) ' Second array dimension is columns.
Debug.Print lists(c, R)
Next R
Next c
x = Range_of_Dates 'UBound(lists, 1)
ReDim lists(x, 1)
i = 1
Do Until i = x
If lists(i) = TodaysDate Then
Exit Do
End If
Loop
MsgBox "The date has not been found"
End Sub
I'm relatively new to VBA and I have been trying to use named ranges to pull in the array but I'm completely at my wits end in trying to solve this piece.
Any help would be greatly appreciated.
You have ReDimmed the array lists from a one dimensioned array to a two dimensioned array and you are then trying to reference an element using only one dimension in the suspect line (below), which is causing your error.
If lists(i) = TodaysDate Then
For reference, Run-time error 9: Subscript out of range means you are referencing a non-existent array element.
I think this is what you are trying?
Sub size_an_array()
Dim i As Integer
Dim TodaysDate As Variant, lists
Dim bFound As Boolean
'~~> Change SomeWorksheet to the relevant sheet
TodaysDate = Sheets("SomeWorksheet").Range("c2")
lists = Sheets("Sheet11").Range("Processed_Dates")
i = 1
Do Until i = UBound(lists)
If lists(i, 1) = TodaysDate Then
bFound = True
Exit Do
End If
i = i + 1
Loop
If bFound = True Then
MsgBox "The date has been found"
Else
MsgBox "The date has not been found"
End If
End Sub
If I understand you correctly then it is much easier to use .Find. If you are interested then have a look at this link.