Posts by W@rrior

Re: Translate This Code For Me?

Actually, stepping through the code would be a more benefic solution for you. Make sure you can see the spreadsheet behind the VBA Editor window, and click anywhere within the Macro code. Then press F8 to step through each line, see what's happening in the spreadsheet.

Re: Shortcut Keys Within Userform Textbox

Kenneth

Need pointers here... Where can I find a list of ascii codes to work with CTRL or ALT or Both...

Thanx

Re: Shortcut Keys Within Userform Textbox

Is this shortcut required to be pressed always in a specific cell? Or anywhere within the userform?

Re: Crash On Userform.show

does the debugger point to a line? If so, wich line does it point to?

Re: Compare Multiple Sheets And Paste Unique Records In Seperate Sheet

Please supply the workbook so we can have a weeeee bit more information to work on...

ie : On sheet1, how is the information laiud-out? Are there multiple instances per customer?

Re: Alphabetical Sort Of Data Within A Cell

Hello dsutton!

I always enjoy a good challenge when I find one...

I've tested this, and it seems to work...

Obviously it's considering only cell A12 like you mentionned in your example. Therefore you will need to slightly adapt the code to cycle through all 12000 entries...

Sub StoreData()
    Dim sString As String
    Dim sTemp As String
    Dim iNoCommas As Integer
    
    sString = Range("A12").Value
    
    ' Evaluate where the commas are positioned
    ' in order to transfer all entries in the
    ' string within array
    
    For i = 1 To Len(sString)
        sTemp = Mid(sString, i, 1)
        If sTemp Like "," Then
            iNoCommas = iNoCommas + 1
        End If
    Next i
    
    ' Update information in cell A12
    Range("A12").Value = SortArray(sString, iNoCommas)
        
End Sub


Function SortArray(sStr As String, iNoCom As Integer) As String


    Dim sStringConv As String
    ReDim aCommas(iNoCom) As Integer
    ReDim aString(iNoCom) As String
    
    ' Strip all spaces from sStr
    For i = 1 To Len(sStr)
        sTemp = Mid(sStr, i, 1)
        If Not sTemp Like "[ ]" Then
            sBuff = sBuff & sTemp
        End If
    Next i
    sStr = sBuff
    
    ' Store start and each comma position to aCommas
    For i = 1 To Len(sStr)
        sTemp = Mid(sStr, i, 1)
        If i = 1 Then aCommas(i - 1) = 1
        If sTemp Like "," Then
            j = j + 1
            aCommas(j) = i
        End If
    Next i
  
    ' Strip and store each words of sString to aString (While stripping the commas)
    For i = 0 To iNoCom - 1
        sBuff = vbNullString
        aString(i) = Mid(sStr, aCommas(i), (aCommas(i + 1) - aCommas(i)))
        For j = 1 To Len(aString(i))
            sTemp = Mid(aString(i), j, 1)
            If Not sTemp Like "[,]" Then
                sBuff = sBuff & sTemp
            End If
        Next j
    aString(i) = sBuff
    Next i
    
    ' Store last entry of sStr to aString
    aString(iNoCom) = Mid(sStr, aCommas(iNoCom), (Len(sStr) - aCommas(iNoCom) + 1))
    sBuff = vbNullString
    For j = 1 To Len(aString(iNoCom))
        sTemp = Mid(aString(iNoCom), j, 1)
        If Not sTemp Like "[,]" Then
            sBuff = sBuff & sTemp
        End If
    Next j
    aString(iNoCom) = sBuff
    
    'Sort aString
    For i = 0 To UBound(aString)
       For j = i To UBound(aString)
            If UCase(aString(j)) < UCase(aString(i)) Then
                str1 = aString(i)
                str2 = aString(j)
                aString(i) = str2
                aString(j) = str1
            End If
        Next j
    Next i
    
    ' Build converted string
    For i = 0 To UBound(aString)
        sStringConv = sStringConv & aString(i)
        If i < UBound(aString) Then sStringConv = sStringConv & ", "
    Next i
    
    SortArray = sStringConv


End Function

Hope this works for you...

Re: Simplifying Code

Hi Oleo!

Try something like this :

Sub CycleSheets()


    Dim i As Integer
    Dim strSheetname As String, strSubname As String
    
    For i = 1 To 15
        strSheetname = Chr(96 + i)     ' "a" having a value of 97, b = 98 ans so forth...
        strSubname = "get_" & strSheetname
        Worksheets(strSheetname).Activate
        Run strSubname
    Next i
    
End Sub

what you put in get_a through get_o is up to ya...

Cya!

Re: Determine Preferred Mail Program

Quote

Sweet!

Please post a code snippet once it's finalized so other searchers will have a solution.

After barging in to my boss' office, I got him to "standardize" the mail programs to either Windows Mail (Outlook Express) or Microsoft Outlook. ([COLOR="Lime"]Weeee![/COLOR])

On to the code:

Function DetermineMailEngine() As Integer


    Dim myMEObj As Object
    Dim RegKey As String
    Dim Key As String
    
    DetermineMailEngine = 0
    Key = "HKEY_LOCAL_MACHINE\SOFTWARE\Clients\Mail\"
    
    'access Windows scripting
    Set myMEObj = CreateObject("WScript.Shell")
    
    'read key from registry
    RegKey = myMEObj.RegRead(Key)
    
    Select Case RegKey
        Case "Windows Mail"
            DetermineMailEngine = 1
        Case "Microsoft Outlook"
            DetermineMailEngine = 2
        Case Else
            DetermineMailEngine = 0
    End Select
    
End Function

Of course this function is part of a bigger code to generate the e-mail & attach file for either mailer program. If needed to help others, I'd gladly attache the code snippet to another reply...

Re: Determine Preferred Mail Program

Thanx Mavyak! That got me in the right direction. :tumble:

Hi!

I'm running a macro that sends an E-Mail with an attachement depending on the value of a specific cell. This code will be run on any of the computers on our network.

I got my macro to either use Outlook or Outlook Express, but since some of the users use either of the programs, I need to be able to determine the preferred mail program they are using. (If only they'd be willing to standardize... 8-) ... )

Does anyone know any trick I might be overlooking?

Thanx!

Re: Returning Unique Entries In Validation Lists

Not without using AdvancedFilter through VBA first...

It would unfortunately duplicate the list, but it should work...

Re: drop down list

AdvancedFilter should do the trick

Re: Extracting A Value From The Title Of The Workbook

Quote from ArtieFish

And thank you W@arrior.

If you don't mind W@rrior, could you just step me through what the code is actually doing. I have a good idea, but it's not all coming together properly for me.

Thanks

Ok here goes :

Len(ActiveWorkbook.Name) will return the lenght of the activeworkbook.name string.
Left(ActiveWorkbook.Name, Len(ActiveWorkbook.Name) - 4) will trim down the .XLS part of workbookname.
Right(Left(ActiveWorkbook.Name, Len(ActiveWorkbook.Name) - 4), 4) will take the last 4 characters starting from the right of the string, that was stripped of it's extension.

Of course, that's all assuming the workbook name will always finish with a 4-digit year number.

Re: Extracting A Value From The Title Of The Workbook

Assuming you are talking about the workbook name, something like this should work fine :

Sub ExtractYear()
    BookName = ActiveWorkbook.Name
    BookName = Left(BookName, Len(BookName) - 4)
    BookNameYear = Right(BookName, 4)
    Range("A1") = BookNameYear
End Sub

Or Simplified :

Sub ExtractYear()
    Range("B1") = Right(Left(ActiveWorkbook.Name, Len(ActiveWorkbook.Name) - 4), 4)
End Sub

Use either as you prefer... Although option 2 makes for smaller code.

Re: Allow Use Of Workbook On Specific Computers Only

Ah, see I didn't know that one... I'll try it out myself... Thanx!

Re: Allow Use Of Workbook On Specific Computers Only

Sounds more like a security-level access question that the network administrator at your company might solve. (ie: Under Windows, create a special policy group containing the users who have rights to open/modify/delete the file, and enforce the policy to said file)

(of course, that's if memory serves, as I haven't done that in 8 years) Hehehe!

Re: Macro Code To Change Picture

When would picture1 need to look like picture2? If it's triggered with a specific cell, you might want to look a this link Conditional Graphic, it helped me out 3 months ago for something similar.

Re: Offset Cell Value Based On Criteria

Quote

However, when I changed the line to read from 0 to 6, I got a "subscript out of range" error for the following line:

Since the range starts at 0 and the array holds 6 element, the range must be 0 to 5. (Thus 6 total)

Re: If Statement Within For...next Loop

Quote from bobwhosmiles

Code

totalRowCount = ActiveSheet.UsedRange.Rows.Count
            
            For rowCounter = 16 To totalRowCount
                sourceCell = "B" & rowCounter


                ActiveSheet.Cells(rowCounter, 12).Formula = _
                    "=IF(LEN(" & sourceCell & ")<=10,TEXT(" & sourceCell & ",""dd/mm/yyyy""),"""")"
            Next rowCounter

Add the red lines to your code :

totalRowCount = ActiveSheet.UsedRange.Rows.Count
            
            For rowCounter = 16 To totalRowCount
                sourceCell = "B" & rowCounter
[COLOR="red"]IF Not ActiveSheet.Range(sourceCell).Value = "A" or "B" or "C" then[/COLOR]
                     ActiveSheet.Cells(rowCounter, 12).Formula = _
                    "=IF(LEN(" & sourceCell & ")<=10,TEXT(" & sourceCell & ",""dd/mm/yyyy""),"""")"
[COLOR="Red"]End If[/COLOR]
            Next rowCounter

Should do the trick.

Re: Offset Cell Value Based On Criteria

Hi!

Your code seems Okay to me...

One questions though, in the following lines

FindWhat =  Array("BB", "B", "CCC", "CC", "C", "CCC+") 
    For i = 0 To 3

Why is i set from 0 to 3 if it's to cycle through the array which holds 6 elements?

Did you set the cell format to be percentage?