Posts by Fencliff

Re: Add Letter To Number

How about something like this:

Private Function NewVarianceLetter(lngQuoteNum As Long, _
    Optional rngQuote As Range) As String
    
    Dim i           As Long
    Dim rngFind     As Range
    
    If rngQuote Is Nothing Then _
        Set rngQuote = ActiveSheet.Cells
    
    Set rngFind = rngQuote
    
    i = 64
    
    On Error Resume Next
    Do Until rngFind Is Nothing
        i = 1 + i
        Set rngFind = rngQuote.Find(What:=lngQuoteNum & Chr(i), LookAt:=xlWhole, _
            MatchCase:=False, SearchFormat:=False)
    Loop
    On Error GoTo 0
    
    NewVarianceLetter = Chr(i)
    
End Function

The argument lngQuoteNum is the number you want to append, and the optional argument rngQuote is the range where the numbers are listed. If you omit this argument, the function will check the entire sheet, and will probably be somewhat slower. The function will return the next available letter as string, counting from A. So if you have the items 1800A, 1800B and 1800D already set, the function will return 1800C, not 1800E.

You can call it either like

NewVarianceLetter(1800, Columns(1))

or simply

NewVarianceLetter(1800)

There is probably a more elegant solution, but this should do the trick.

Re: Add A Variation Letter To A Number

Hi,

Could you give a little more descriptive example of what you want to do? Do you want to convert an existing list of numbers so that non-unique numbers will have an identification letter, or do you want to automatically add a letter every time a number is punched in?

Re: Message After Enter For More Than One Decimal

I'm not sure what you're doing is a superb idea, because that way instead of having the formulas look off, you will have statistical inaccuracy up to wazoo.

In any case, here's some code that should do what you want. Just put it in the sheet's module.

Private Sub Worksheet_Change(ByVal Target As Range)


'   Check that the inserted value is a number
    If IsNumeric(Target.Value) Then
    
'       If the inserted value does not equal the rounded value
        If Not Target.Value = Round(Target.Value, 1) Then
        
'           Pop a message box
            MsgBox "Number has been rounded"
            
'           Round the value
            Target.Value = Round(Target.Value, 1)
            
        End If
    End If
End Sub

Re: Give Workbook An Identifier

Thank you, Sir!

Sometimes being-self taught really shows, I hadn't even thought of using the document properties to carry data.

For people who might be looking for something similar in the future, here is subprocedure to add a custom document property to a workbook, and a function to check if a workbook has that property:

Private Sub AddCustomBooleanProperty(sPropertyName As String)


    ActiveWorkbook.CustomDocumentProperties.Add _
        Name:=sPropertyName _
        LinkToContent:=False, _
        Type:=msoPropertyTypeBoolean, _
        Value:=True
        
End Sub


Public Function fHasProperty(sPropertyName As String) As Boolean
    Dim objProperty As DocumentProperty
    
    On Error Resume Next
    Set objProperty = ActiveWorkbook.CustomDocumentProperties(sPropertyName)
    
    If Err = 0 Then
        fHasProperty = True
    Else
        fHasProperty = False
    End If
    
End Function

Thanks again, Andy.

Hi All,

Here at work we have a set of 12 workbooks, that form an extensive activity plan. I have created an add-in that creates a worksheet menu bar item and adds different functionalities to these 12 files.

Because any user might have more than one of these documents open at one time, I am forced to refer to the documents by ActiveWorkbook. A bonus added feature: the names of these files change periodically, but not at the same time.

Before running any procedure I must validate that the active book is one of these files. Currently I am testing the existence of a veryhidden sheet codenamed "shIsValid" in the workbook. Now I'm thinking, there has to be a better way to do this.

Simplest way would be if ThisWorkbook object had a Tag property similar to UserForms, but this doesn't seem to be the case. I wonder, is there actually a way to give a workbook any identifier (boolean, string or number) that I can access directly, so I can get rid of these dummy worksheets.

Re: Checkbox Pops Up Msgbox

Quote from ejlupien

Thanks for the reply ... not sure why I was thinking about If Not Intersect ... in the end the following does what I wanted.

Code

Private Sub CheckBox79_Click()
    If Range("A1").Value = "True" Then
        Range("A2") = "False"
    End If
End Sub

That code will set cell A2 to False the first time cell A1 becomes True, and keep it so for all foreseeable future. Is that what you want?

If you want A2 to be False when A1 is True and vice versa, use this instead:

Range("A2") = Not Range("A1")

Re: Get The Value Of A Cell Before It Was Changed

Personally I would use a veryhidden sheet to store the old value, that way it is retained over workbook saving and reopening. The simplest way to do this is probably to keep to running cells, one that stores the previous value and one for the new entry. Like so:

Private Sub Worksheet_Change(ByVal Target As Range)
    
    If Not Intersect(Target, Range("B2")) Is Nothing Then
        Set rOld = Worksheets("HiddenSheet").Range("A1")
        Set rNew = Worksheets("HiddenSheet").Range("A2")
        
        rOld.Value = rNew.Value
        rNew.Value = Target.Value
    End If
 
End Sub

Re: Copy Matching Data From 2 Worksheets

How about if you tell us all the requirements (regarding formatting etc.) you have for this macro, perhaps that'll help us evaluate what would be the best solution for your case?

Re: Insert Row By Looking Up Different Values

Does this do what you need?

Sub CompareAndCopy()


    Dim CurrCell        As Range
    Dim CriteriaRange   As Range
    Dim FindMatchJ      As Range
    Dim FindMatchM      As Range
    Dim i As Integer
    
    Set CriteriaRange = ThisWorkbook.Worksheets("Criteria").Range("A1").CurrentRegion
    i = 1
    
    Do Until IsEmpty(Range("A" & i))
        Set CurrCell = Range("A" & i)
        
        Set FindMatchJ = CriteriaRange.Find(What:=Range("J" & i).Value, LookIn:=xlValues, _
            LookAt:=xlWhole, MatchCase:=True)
        Set FindMatchM = CriteriaRange.Find(What:=Range("M" & i).Value, LookIn:=xlValues, _
            LookAt:=xlWhole, MatchCase:=True)
        
        If FindMatchJ Is Nothing And FindMatchM Is Nothing And _
           Not Range("C" & i) Like "9*" Then
            With CurrCell.EntireRow
                .Insert Shift:=xlShiftDown
                .Offset(-1, 0).Value = .Value
            End With
            
            Range("C" & i).Value = Range("C" & i).Value - 1
            Range("E" & i).Value = Range("E" & i).Value + 1
            i = 1 + i
        End If
        
        Set FindMatchJ = Nothing
        Set FindMatchM = Nothing
        
        i = 1 + i
    Loop
End Sub

Re: Variables To Make Up Range

jindon,

I think your method will actually convert the range (if vCol is "A") A9:A53. To convert two unattached ranges just do the conversion twice, for rows 9-35 and 48-53 separately.

Brgds,
Fencliff

Re: Lock Computer

O well... trying to figure out quasi-trivial api calls really is a pain. I just wish VBE shipped with the same API Manager Add-in VB6 did, would make life a lot easier of all of us.

Re: Lock Computer With Vba

And here is the specific API Call to lock the computer. Just place the declaration on the top of your module before any procedures.

Private Declare Function LockWorkStation Lib "user32.dll" () As Long


Private Sub LockStation()
    LockWorkStation
End Sub

Brgds,
Fencliff

Re: Macro To Match Data Line By Line

Hi,

The macro you are descibing sounds like a simple job, but if this is a one-time mapping (?) then I would instead of writing a procedure just use VLOOKUP from sheet AP to Move and vice versa to get matches both ways, then add the lists together and filter for uniques. The ones that don't show up on that list don't have a match.

Re: Unhide Worksheet With Same Label Name

Just add this to any module, and assign the macro ToggleSheetVisibility to all your labels. Clicking the label should then show/hide the sheet named same as the label caption

Private Sub ToggleSheetVisibility()


    Dim sSheetName As String
    
    sSheetName = ActiveSheet.Shapes(Application.Caller).TextFrame.Characters.Text
    
    On Error GoTo Not_Found
    With ThisWorkbook.Sheets(sSheetName)
        .Visible = Not .Visible
    End With
    
    Exit Sub
Not_Found:
    MsgBox "No sheet name matches to the label name"
    
End Sub

Re: Hotkey To Jump From Cell To Cell

Rather than an if-elseif construct, I would use Select Case:

Select Case ActiveCell.Address


    Case Is = [A1].Address: [A9].Select
    Case Is = [A9].Address: [B1].Select
    Case Is = [B1].Address: [B9].Select
    Case Is = [B9].Address: [C1].Select
    Case Is = [C1].Address: [C9].Select
    Case Is = [C9].Address: [D1].Select
    Case Is = [D1].Address: [D9].Select
    Case Else: [A1].Select
    
End Select

Unlike an if-elseif statement, Select case doesn't need to evaluate all the conditions before executing the code, so it is more efficient.

Re: Format Border Based On Cell Content

Hi, only changed one line in the code:

Private Sub CBPAGrid_Click() 
     
    Dim rCell As Range 
    Dim rRange As Range 
     
    Set rRange = Range("E18", Range("E1000").End(xlUp)) 
     
    For Each rCell In rRange 
        If Not IsEmpty(rCell) And _ 
        Not IsEmpty(rCell.Offset(1, 0)) Then 
            With rCell 
                If .Value <> .Offset(1, 0).Value Then 
                    With Range("A" & rCell.Row, "BB" & rCell.Row).Borders(xlEdgeBottom) 
                        .Weight = xlMedium 
                    End With 
                End If 
            End With 
        End If 
    Next rCell 
     
End Sub

Re: Running A Procedure Upon/after Autofilter

Quote from Dave Hawley

Yes, any Volatile Function and the SUBTOTAL Function will fire upon the use of AutoFilter. So you could use a dummy worksheet with ONLY a SUBTOTAL Function on it that refers to the problem Worksheet. Then right click on the Worksheet name tab, choose View Code and use this, change Sheet2 code name to the CodeName of your problem Worksheet.

Beautiful! I never even considered this kind of workaround. Thanks, Dave.

Re: Cancelling Events Disabled?

Neither do I, and the likelihood of such setting existing seems a little arbitrary. Still, this feature has worked perfectly so far, and suddenly not. P***** me off

Re: Cancelling Events Disabled?

Hi Norie,

I wish that was the case. Unfortunately my events work otherwise perfectly, just not the cancelling.

Rgds,
Jani

Hi all,

I have a peculiar problem. The boolean Cancel suddenly stopped working for me in all workbook and worksheet events. Consider a simple example:

Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
    Cancel = True
End Sub

does not cancel right click, like it has before. Same with BeforeDoubleClick. I can only assume it is some kind of a setting or similar, as there is absolutely no change in the code.

Has anybody seen this issue before, and how to correct it?