VB code is not working like it should

[Bob Reynolds]

I have a very specific spreadsheet that I acquired some vb off of the
newsgroups. Unfortunately I have one formula in vb that is quite lengthy and
I can't get it to work on the workbook that I have. I've tried everything
that I know (not much) and could use some help. If someone needs it to look
at it can be provided.

I've attached the vb code so you can see what I'm talking about b4 looking
at mine.
Basically it goes to the "Examples" sheet and looks in the defined range
letters. There can be 31 entries there and it looks up and down and gives
the starting letter and the ending letter. Once it does this it's supposed
to put those two letters into the concatenate formula with a result of A
through to AA, or something like that. When I run it it returns nothing but
the "through to".....Any help would be appreciated..

Bob
Sub findfirstandlast()

Dim rng As Range
Dim myarray(2) As String
Dim settext As String

settext = """ through to """


Set rng = Sheets("EXAMPLES").Range("rng_Letters")
For Each cell In rng
If cell = "A" Then
myarray(1) = "A"
Exit For
ElseIf cell = "B" Then
myarray(1) = "B"
Exit For
ElseIf cell = "C" Then
myarray(1) = "C"
Exit For
ElseIf cell = "D" Then
myarray(1) = "D"
Exit For
ElseIf cell = "E" Then
myarray(1) = "E"
Exit For
ElseIf cell = "F" Then
myarray(1) = "F"
Exit For
ElseIf cell = "G" Then
myarray(1) = "G"
Exit For
ElseIf cell = "H" Then
myarray(1) = "H"
Exit For
ElseIf cell = "I" Then
myarray(1) = "I"
Exit For
ElseIf cell = "J" Then
myarray(1) = "J"
Exit For
ElseIf cell = "K" Then
myarray(1) = "K"
Exit For
ElseIf cell = "L" Then
myarray(1) = "L"
Exit For
ElseIf cell = "M" Then
myarray(1) = "M"
Exit For
ElseIf cell = "N" Then
myarray(1) = "N"
Exit For
ElseIf cell = "O" Then
myarray(1) = "O"
Exit For
ElseIf cell = "P" Then
myarray(1) = "P"
Exit For
ElseIf cell = "Q" Then
myarray(1) = "Q"
Exit For
ElseIf cell = "R" Then
myarray(1) = "R"
Exit For
ElseIf cell = "S" Then
myarray(1) = "S"
Exit For
ElseIf cell = "T" Then
myarray(1) = "T"
Exit For
ElseIf cell = "U" Then
myarray(1) = "U"
Exit For
ElseIf cell = "V" Then
myarray(1) = "V"
Exit For
ElseIf cell = "W" Then
myarray(1) = "W"
Exit For
ElseIf cell = "X" Then
myarray(1) = "X"
Exit For
ElseIf cell = "Y" Then
myarray(1) = "Y"
Exit For
ElseIf cell = "Z" Then
myarray(1) = "Z"
Exit For
ElseIf cell = "AA" Then
myarray(1) = "AA"
Exit For
ElseIf cell = "AB" Then
myarray(1) = "AB"
Exit For
ElseIf cell = "AC" Then
myarray(1) = "AC"
Exit For
ElseIf cell = "AD" Then
myarray(1) = "AD"
Exit For
ElseIf cell = "AE" Then
myarray(1) = "AE"
Exit For
ElseIf cell = "AF" Then
myarray(1) = "AF"
Exit For

End If
Next

For Each cell In rng
If cell = "AF" Then
myarray(2) = "AF"
ElseIf cell = "AE" Then
myarray(2) = "AE"
ElseIf cell = "AD" Then
myarray(2) = "AD"
ElseIf cell = "AC" Then
myarray(2) = "AC"
ElseIf cell = "AB" Then
myarray(2) = "AB"
ElseIf cell = "AA" Then
myarray(2) = "AA"
ElseIf cell = "Z" Then
myarray(2) = "Z"
ElseIf cell = "Y" Then
myarray(2) = "Y"
ElseIf cell = "X" Then
myarray(2) = "X"
ElseIf cell = "W" Then
myarray(2) = "W"
ElseIf cell = "V" Then
myarray(2) = "V"
ElseIf cell = "U" Then
myarray(2) = "U"
ElseIf cell = "T" Then
myarray(2) = "T"
ElseIf cell = "S" Then
myarray(2) = "S"
ElseIf cell = "R" Then
myarray(2) = "R"
ElseIf cell = "Q" Then
myarray(2) = "Q"
ElseIf cell = "P" Then
myarray(2) = "P"
ElseIf cell = "O" Then
myarray(2) = "O"
ElseIf cell = "N" Then
myarray(2) = "N"
ElseIf cell = "M" Then
myarray(2) = "M"
ElseIf cell = "L" Then
myarray(2) = "L"
ElseIf cell = "K" Then
myarray(2) = "K"
ElseIf cell = "J" Then
myarray(2) = "J"
ElseIf cell = "I" Then
myarray(2) = "I"
ElseIf cell = "H" Then
myarray(2) = "H"
ElseIf cell = "G" Then
myarray(2) = "G"
ElseIf cell = "F" Then
myarray(2) = "F"
ElseIf cell = "E" Then
myarray(2) = "E"
ElseIf cell = "D" Then
myarray(2) = "D"
ElseIf cell = "C" Then
myarray(2) = "C"
ElseIf cell = "B" Then
myarray(2) = "B"
ElseIf cell = "A" Then
myarray(2) = "A"

End If
Next
Sheets("Data Entry_").Select
Range("K33").FormulaR1C1 = "=Concatenate(""" & myarray(1) & """," &
settext & " ,""" & myarray(2) & """)"

End Sub

 

[Greg Wilson]

Your code works for at least as far as I can tell. Your
description suggests that the code is not finding the
letters in the named range "rng_Letters". Are you sure
this named range is valid? Also note the underscore
character in the sheet name "Data Entry_". This seems
suspicious although you should get an error message if
this is spelled wrong.

For what it's worth, I put your code on a "low carb" diet
and came up with the following:

Sub findfirstandlast()
Dim Arr(31) As String
Dim rng As Range, cell As Range
Dim i As Integer
Dim txt1 As String, txt2 As String
Dim settext As String

Set rng = Sheets("EXAMPLES").Range("rng_Letters")
settext = " through to "
txt1 = ""
txt2 = ""

For i = 0 To 25
Arr(i) = Chr(i + 65)
Next
For i = 26 To 31
Arr(i) = "A" & Chr(i + 39)
Next

For i = 0 To 31
For Each cell In rng
If cell = Arr(i) Then
txt1 = Arr(i)
Exit For
End If
Next
If txt1 <> "" Then Exit For
Next

For i = 31 To 0 Step -1
For Each cell In rng
If cell.Value = Arr(i) Then
txt2 = Arr(i)
Exit For
End If
Next
If txt2 <> "" Then Exit For
Next

Sheets("Data Entry_").Select
Range("K33") = txt1 & settext & txt2
End Sub

Regards,
Greg

 

[Bob Reynolds]

Thank you Greg.
I confimed the rng_Letters was accurate and in fact redefined them thinking
something may have gone askew. The underscore is there so that an index
won't list that sheet, so it's correct.
Would looking at the workbook help solve the problem, I can do that?
I'm going to try this "low carb" and see if it might work..

Thanks
BOB

 

[Bob Reynolds]

Low Carb version returns the same thing, the text through to is the only
displayed item.

BOB

 

[Greg Wilson]

Bob,

Both your code and mine work for me when I create a named
range called "rng_Letters" and enter the upper case
letters into the range. Both procedures will fail if the
cells contain anything in addition to the letters
(including empty spaces). It'll probably save us both some
time if you just email me the workbook if that's what you
were suggesting. No guarantees.

(e-mail address removed)

Regards,
Greg

 

[Bob Reynolds]

Would it make any difference if this formula was looking at cells that had
forumlas in them. The formulas are used to link with another field for the
letters?

If it would help I could email the worksheet to you if you could figure it
out??
Thnks

BOB

 

[Greg Wilson]

It shouldn't make a difference as far as I can see if the
cells contain formula instead of constants. The macro
tests the value property of the cells in the named range.
Whether the value is returned from a formula or is
inputted as a constant shouldn't make any difference. My
code worked in a simple test when formulae were used.

As I said, it's OK with me if you email me the workbook.
Remove anything confidential plus anything large and
unnecessary. Ensure that the VB Project is not locked of
course. I'll try to find the time this weekend. I'm
working this weekend so I'll be a bit short on time.

(e-mail address removed)

Regards,
Greg

 

[Greg Wilson]

Bob,

Your workbook was a lot more elaborate than I had
anticipated. I was only able to take a brief look as I
havn't a great deal of time to devote to it. My findings
were as follows:

**** Finding 1 ****
Note that the worksheet functions in both the named
ranges "rng_Letters" and "RangeDetails" return two(2)
characters. For example:
=RIGHT('Installment Agrmt PaymntPlan'!$H$50,2)
Therefore, when the cell refered to in the formula
is "Exibit: AC" this will return "AC" which should be OK.
However, when the cell refered to is "Exibit: A" then the
formula returns " A". Note the blank space. Here is a
snippet of your original code:
If cell = "A" Then
You can see how it would NOT determine this to be True.
The situation was similar for my code which made the
comparison between the cell value (e.g. " A") and elements
in an array which contained no blanks. I made mention of
this possibility in one of my follow-up posts.

The solution is simply to incorporate the Trim function
with your worksheet functions; or, alternatively, use it
in the macro. This removes blank leading and trailing
spaces in text. I think it's preferable to use it in the
worksheet function in order to eliminate the flaw. For
example:
=Trim(RIGHT('Installment Agrmt PaymntPlan'!$H$50,2))
I append a version of my macro ("Alternate Code") that
incorporates the Trim function if you prefer. Note that
when I made this change cell K33 did include the letters.

***** Finding 2 *****
Note that named range "RangeDetails" references the
range 'Data Entry_'!$AB$2:$AB$11 while the cells with the
worksheet functions are in the range $AB$13:$AB$43 on
sheet "Data Entry_".

***** Finding 3 *****
This is only a suggestion perhaps for future reference. I
suggest you take a look at using the EnableSelection
property, at least for the more elaborate worksheets. You
can set it such that the user cannot even click on a cell
that is not intended for data entry. This makes navigation
much simpler IMHO. However, this has to be reset each time
the workbook is opened as it defaults to xlNoRestrictions.
You'll need to set this using code in the Workbook_Open
event.

Try this experimentally:
1) First ensure that All cells on the worksheet are locked
except those intended for data entry. To do this, first
select all cells by clicking on the blank space in the Row
and Column Headers area; i.e. immediately above the number
1 and to the left of the letter A. Then set the Locked
property of all cells to True through
Format|Cells|Protection tab.
2) Then go back over and unlock only the cells intended
for data entry.
3) Finally paste this code to the ThisWorkbook module.
Note that for earlier versions of Excel you may have to
first unprotect and then protect the worksheets before you
can change the EnableSelection property. I believe this
was true for xl97. If so, add the unprotect and reprotect
lines to the code.

Private Sub Workbook_Open()
Dim WS As Worksheet
For Each WS In ThisWorkbook.Worksheets
WS.EnableSelection = xlUnlockedCells
Next
End Sub

***** Finding 4 *****
It may just be me, but your use of the Class module had me
confused. Can you not do this automatic highlighting using
the worksheet code module(s) for the sheet(s) involved?
There is also the problem that when you close the
workbook, the last cell highlighted remains so and then
memory is lost. When you reopen the workbook this cell
will still be highlighted and the code won't remember it.
So it won't get unhighlighted when you click on another
cell (The code looks like something I wrote so I shouldn't
be too critical). Suggested is that you declare the
OldCell variable as Public and unhighlight it using the
Workbook_BeforeClose event. Then paste the highlight code
to the worksheet code module(s) instead:-

'(Minimal testing and not used by me for any project)
Paste to a standard module:
Public OldCell As Range

Paste to the ThisWorkbook module:
Private Sub Workbook_Deactivate()
OldCell.Interior.ColorIndex = xlNone
End Sub

Paste to the worksheet code module(s):
Private Sub Worksheet_SelectionChange(ByVal Target As
Range)
If Not OldCell Is Nothing Then
OldCell.Interior.ColorIndex = xlColorIndexNone
End If
Target.Interior.ColorIndex = 6
Set OldCell = Target
End Sub


***** Alternate Code with Trim function *****
Sub findfirstandlast()
Dim Arr(31) As String
Dim rng As Range, cell As Range
Dim i As Integer
Dim txt1 As String, txt2 As String
Dim settext As String

Set rng = Range("rng_Letters")
'Set rng = Sheets("Data Entry_").Range("RangeDetails")
settext = " through to "
txt1 = ""
txt2 = ""

For i = 0 To 25
Arr(i) = Chr(i + 65)
Next
For i = 26 To 30
Arr(i) = "A" & Chr(i + 39)
Next

For i = 0 To 30
For Each cell In rng
If Trim(cell) = Arr(i) Then
txt1 = Arr(i)
Exit For
End If
Next
If txt1 <> "" Then Exit For
Next

For i = 30 To 0 Step -1
For Each cell In rng
If Trim(cell) = Arr(i) Then
txt2 = Arr(i)
Exit For
End If
Next
If txt2 <> "" Then Exit For
Next

Sheets("Data Entry_").Select
Range("K33") = txt1 & settext & txt2
End Sub

Regards,
Greg

 

[Greg Wilson]

In response to your email request to also format the K34
value, I suggest the below appended code.

Note that it's possible to dispence with the named range
"rng_Letters" and use another array instead. The macro
could extract the letters from the $H$50 cells in the
necessary worksheets and populate the array accordingly.
Then the elements in this array could be compared to the
elements in the existing Arr array instead of doing the
comparison to the cells in the named range.

I rejected this (at least for now) because, IMO, for a
workbook this large, it's usually a good idea to have a
helper sheet. However, I strongly advise hiding the sheet
(xlVeryHidden). You can use it to store values, notes,
settings or whatever. For this particular workbook, there
is a complication involved in iterating through the
worksheets in order to populate the array that I won't go
into for the sake of brevity. Not that it can't be done,
just that I think I would do it this way if it were me.
Maybe I'll change my mind(?). Code follows:


Sub findfirstandlast()
Dim Arr(31) As String
Dim rng As Range, cell As Range
Dim i As Integer
Dim txt1 As String, txt2 As String, txt3 As String
Dim settext As String

Set rng = Range("rng_Letters")
settext = " through to "
txt1 = ""
txt2 = ""
txt3 = ""

On Error Resume Next
For i = 0 To 25
Arr(i) = Chr(i + 65)
Next
For i = 26 To 30
Arr(i) = "A" & Chr(i + 39)
Next

For i = 0 To 30
For Each cell In rng
If Trim(cell) = Arr(i) Then
txt1 = Arr(i)
Exit For
End If
Next
If txt1 <> "" Then Exit For
Next

For i = 30 To 0 Step -1
For Each cell In rng
If Trim(cell) = Arr(i) Then
txt2 = Arr(i)
txt3 = Arr(i + 1)
Exit For
End If
Next
If txt2 <> "" Then Exit For
Next

Sheets("Data Entry_").Select
Range("K33") = txt1 & settext & txt2
Range("K34") = txt3
On Error GoTo 0
End Sub

Regards,
Greg

 

[Bob Reynolds]

WOW,
I'd like to see what you can do when you have time to review them. I tweaked
a couple of things and changed a couple of things per some of your
recomendations. It appears all is working as I needed it to.

As a note if anyone thinks this problem could help them I have no problem in
sending the workbook to them for all of us to learn.
Greg thanks so much, you work is very much appreciated..
BOB