Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
VB code is not working like it should
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 |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
VB code is not working like it should
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 |
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
VB code is not working like it should
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 "Greg Wilson" wrote in message ... 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 |
#4
Posted to microsoft.public.excel.programming
|
|||
|
|||
VB code is not working like it should
Low Carb version returns the same thing, the text through to is the only
displayed item. BOB "Bob Reynolds" wrote in message ... 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 "Greg Wilson" wrote in message ... 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 |
#6
Posted to microsoft.public.excel.programming
|
|||
|
|||
VB code is not working like it should
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 "Bob Reynolds" wrote in message ... Low Carb version returns the same thing, the text through to is the only displayed item. BOB "Bob Reynolds" wrote in message ... 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 "Greg Wilson" wrote in message ... 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 |
#7
Posted to microsoft.public.excel.programming
|
|||
|
|||
VB code is not working like it should
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. Regards, Greg |
#8
Posted to microsoft.public.excel.programming
|
|||
|
|||
VB code is not working like it should
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 |
#9
Posted to microsoft.public.excel.programming
|
|||
|
|||
VB code is not working like it should
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 |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
VBA Code Not Working | Excel Discussion (Misc queries) | |||
Vb Code not working | Excel Programming | |||
Code not Working - Help please | Excel Programming | |||
why this code not working | Excel Programming | |||
For Each Code Not Working | Excel Programming |