Posts by lasw10

lasw10 · Jul 18th 2005

Re: find next loop VBA

ok shame...

Code

Private Sub CommandButton1_Click()
Dim wb As String
wb = ActiveWorkbook.Name
Dim Rng1 As Range, c As Range
Dim strAddress As Range
Dim MyVar As String
MyVar = UserForm1.TextBox1.Text
If MyVar = "" Then
    MsgBox "Please enter Vendor Number.", vbOKOnly, "Error"
End If
Set Rng1 = Range("A1:T30000") 'I would actually use CurrentRegion or usedRange here
With Rng1
    Set c = .Find(what:=MyVar, LookAt:=xlPart, LookIn:=xlValues, SearchDirection:=xlNext)
    If Not c Is Nothing Then
        Application.ScreenUpdating = False
        Workbooks.Add
        ActiveWorkbook.SaveAs ("C:\whatever.xls")
        Dim p_rw As Integer
        p_rw = 2
        Windows(wb).Activate
        Do Until c Is Nothing Or c.Interior.ColorIndex = 3
            c.Interior.ColorIndex = 3 'highlight foun cell, amend action to suit
            Range(Cells(c.Row, 1), Cells(c.Row, 26)).Copy
            Windows("whatever").Activate
            Cells(p_rw, 1).PasteSpecial xlPasteValues
            p_rw = p_rw + 1
            Windows(wb).Activate
            Set c = .FindNext(c)
        Loop
        Application.ScreenUpdating = True
    Else
        MsgBox "Cannot Find " & searchtxt.Text & ".", vbOKOnly, "Sorry"
    End If
End With
End Sub

Display More

Not particularly clean or watertight but should give you the general idea...

lasw10 · Jul 18th 2005

Re: populating one worksheet with another

as for your other code - can you explain what you're trying to do with your concatenate macro - we can see why it's not working - but can't fix without knowing what you're trying to do exactly... specify ranges etc as much as possible (including specific cells)

lasw10 · Jul 18th 2005

Re: populating one worksheet with another

ok well for starters...

to mimic one sheet to another (without the need for VBA) just activate the "master" sheet and then hold down CTRL and click on the "slave" sheet - both will now be highlighted - they are now "Grouped" so whatever you enter on one will be entered on the other.

unfortunately the grouping does not stay constant...

so if you want a VBA solution - use a workbook sheet change event along the lines of

Code

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim s1 As String    'MASTER WORKSHEET NAME
Dim s2 As String    'SLAVE WORKSHEET NAME
s1 = "MASTER"
s2 = "SLAVE"
If UCase(Sh.Name) = s1 Then
    Sheets(s2).Cells(Target.Row, Target.Column) = Target.Value
End If
End Sub

if the name of the sheet that is changed matches your criteria as being the master sheet it will just copy the cell that's changed to the identical cell location on your designated other worksheet.

lasw10 · Jul 18th 2005

Re: find next loop VBA

not an answer I am afraid - more a question...

where are you gettign this data from? is it a download from a database etc? If it is, you will find it easier to tweak the code returning the data direct from the db rather than in XL - you should never aim to have 30,000 rows of data in a spreadsheet.... it's not an efficient db tool for this kind of thing unfortunately.

let us know if it is db related - and if so - what db and if you have the code used to retrieve it post that too...

in the meantime I am sure someone will give you an XL VBA answer sooner rather than later...

lasw10 · Jul 18th 2005

Re: Match Item #

can you not simply create another column say D

where

D5 = 0+left(A5,3)

then

E5 = SUMIF(D:D,D5,C:C)

lasw10 · Jul 18th 2005

Re: Percentage change

could you give us some sample data with expected results so we can prove the results etc with formulae for you

lasw10 · Jul 18th 2005

Re: Adding and subtracting in cells - without iteration

I am not entirely sure I follow what you're trying to do but how about this:

Code

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
If Sh.Name <> "Sheet1" Then Exit Sub
If Target.Column <> 1 Then Exit Sub
If IsNumeric(Target.Value) Then
    Target.Offset(0, 5) = Target.Offset(0, 5) + Target.Value
End If
End Sub

This would be a sheet change event (ie every time a cell is changed)

Will exit if not cell changed not say in Column A of Sheet1... if it is it changes corresponding F value to equal original F value + value of cell in A that's changed (if it's numeric).

This code would sit in "ThisWorkbook" module in VBA

lasw10 · Jul 14th 2005

Re: Daily Email job

as a general rule I'd suggest avoiding using object libraries as much as possible (unless you really need to) purely because of binding issues ... there are ways to bind libraries automatically (often using the GUID) which can get around the problem of handling multiple operating systems but for what you're trying to achieve I'd say this is overkill

An ex. problem would be if you manually bind the Outlook library to your file say on XP and then distributed it to say someone running an archaic OS (like NT4 or Me etc...) - the library you have issued would be vn 10.0 whereas that version would not be available to the other user and your code would debug as soon as the file was opened... (note the reverse is not an issue - ie distributing version 9 to a user where only 10 is available would not cause a prob as XL would simply switch to 10... backwards compatability doesn't work in this instance).

As i said - using the GUID with major/minor version references gets around this but for a simple email routine it's just not worthwhile... I tend to only use it when distributing files heavily reliant on ADO etc...

An ex. of emailing without requiring the OL library itself be referenced can be found at the below URL - although in this instance we're using HTML format - the basic premise of creating the OL object and generating the mail (see all e. variables) is what you want.

http://www.ozgrid.com/forum/showthread.php?t=36164

If anyone thinks the above assumptions are incorrect please feel free to correct me - but in my experience - this is the best approach.

lasw10 · Jul 11th 2005

Re: remove all non alpha characters in sql

Sorry,

I can't think of any *quick* way of doing this given the chars to be removed are variable... you know that any char < 65 or > 122 is non-alpha but I can't think of a quick way to get this into a SQL statement I'm afraid... i guess I'd do the stripping elsewhere (ie wherever you're returning the recordset?)

lasw10 · Jul 11th 2005

Re: Formula Help Required

or if you prefer - a little vba function

Code

Function txtstr(win As String, lin As String, aix As String)
txtstr = ""
If win = "x" Then txtstr = txtstr & "Windows; "
If lin = "x" Then txtstr = txtstr & "Linux; "
If aix = "x" Then txtstr = txtstr & "AIX"
End Function

so d1 then =txtstr(a1,b1,c1)

would return appropriate string given values of a, b & c1

lasw10 · Jul 11th 2005

Re: Rounding a Single type var value before assigning it to another var

x = round(var,2)

lasw10 · Jul 11th 2005

Re: remove all non alpha characters in sql

do you mean remove chars from an actual statement or do you mean use a statement to remove chars from the resulting string of a statement??

i don't know of any function that removes all non-alpha chars - the only way I know would be to use a replace function and in truth that's not going to be very efficient.

Which db are you using and where are you returning the resulting string to? ie if in Access you may find it easier to build a function to do this (iterating the resulting string char by char) - ie an adaption of XL's CLEAN function but for all chars with an id > x...

lasw10 · Jul 11th 2005

Re: Save Emails

if you have some code already please post it up so we can see how you're generating your mails...

if you save a message - then by default it will go to your draft folder...

Below code is an HTML email generator but it should give you a general idea of how it's done in XL VBA...

eg.

Code

Dim SENDIT As String
        SENDIT = ""
        If e_usr = "FD2" Then SENDIT = "SEND"
        
        Dim FOOTER As String
        Dim subject, msg As String
        
        subject = "Overdue Timesheet(s) - " & Cells(rw, 1)
        msg = "The following timesheets are overdue.<BR><BR>Please ensure these timesheets are posted as a matter of urgency."
        note = "Line Managers: Please ensure these timesheets are posted as a priority."
        warning = "This email will continue to escalate until all necessary timesheets have been submitted for approval."
        
        Set o = GetObject(, "Outlook.Application")
        Set e = o.createitem(0)
        
        'importance
        e.importance = 2
        'subject
        e.subject = subject
        
        'table - showing days etc
        mailtable = "<TABLE cellpadding=4 cellspacing=4>"
        mailtable = mailtable & "<TR>"
            'headers
            mailtable = mailtable & "<TD align=center><font face=" & Chr(34) & "Trebuchet MS" & Chr(34) & " size=2 color=black><b>TIME PERIOD COMMENCING</font></b>"
            mailtable = mailtable & "<TD align=center><font face=" & Chr(34) & "Trebuchet MS" & Chr(34) & " size=2 color=black><b>REQUIRED HRS</font></b>"
            mailtable = mailtable & "<TD align=center><font face=" & Chr(34) & "Trebuchet MS" & Chr(34) & " size=2 color=black><b>ACTUAL HRS</font></b>"
            'rw
            mailtable = mailtable & rw_str
            
        mailtable = mailtable & "</TABLE>"
        
        'body of email
        e.HTMLbody = "<HTML>"
        e.HTMLbody = e.HTMLbody & "<BODY bgcolor=white>"
            
            e.HTMLbody = e.HTMLbody & "<font face=" & Chr(34) & "Trebuchet MS" & Chr(34) & " size=2 color=black>"
                e.HTMLbody = e.HTMLbody & Left(Sheets(s1).Cells(rw, 1), InStr(Sheets(s1).Cells(rw, 1), " ") - 1) & ",<BR><BR> "
                e.HTMLbody = e.HTMLbody & msg & "<BR><BR>"
            e.HTMLbody = e.HTMLbody & "</font>"
                
            e.HTMLbody = e.HTMLbody & "<hr size=1>"
            
            e.HTMLbody = e.HTMLbody & mailtable
        
            e.HTMLbody = e.HTMLbody & "<hr size=1>"
            
            e.HTMLbody = e.HTMLbody & "<BR>"
                        
            'only include note where line managers are receiving email (severity >= 1)
            If sev > 1 Then
            'e.HTMLbody = e.HTMLbody & "<font face=" & Chr(34) & "Trebuchet MS" & Chr(34) & " size=2 color=black><b>"
            '    e.HTMLbody = e.HTMLbody & note & "<BR><BR>"
            'e.HTMLbody = e.HTMLbody & "</font></b>"
            'e.HTMLbody = e.HTMLbody & "<BR>"
            End If
            
            e.HTMLbody = e.HTMLbody & "<font face=" & Chr(34) & "Trebuchet MS" & Chr(34) & " size=2 color=red><b>"
                e.HTMLbody = e.HTMLbody & UCase(warning)
            e.HTMLbody = e.HTMLbody & "</font></b>"
            e.HTMLbody = e.HTMLbody & "<BR>"
            
            e.HTMLbody = e.HTMLbody & "<BR>"
        
        'footer to add to body
        FOOTER = ""
        FOOTER = FOOTER & "<font face=" & Chr(34) & "Trebuchet MS" & Chr(34) & " size=2 color=black>"
            FOOTER = FOOTER & "Regards,<BR>Finance Department<BR><BR>"
            FOOTER = FOOTER & "<hr size=1>"
            FOOTER = FOOTER & "Login at <a href=hyperlink.aspx>"
                FOOTER = FOOTER & "<font face=" & Chr(34) & "Trebuchet MS" & Chr(34) & " size=2 color=navy>"
                    FOOTER = FOOTER & "http://hyperlink.aspx"
                FOOTER = FOOTER & "</font>"
            FOOTER = FOOTER & "</a> "
        
            FOOTER = FOOTER & "<hr size=1>"
        
            FOOTER = FOOTER & "<BR>"
            FOOTER = FOOTER & "<font face=" & Chr(34) & "Trebuchet MS" & Chr(34) & " size=3 color=red><b>"
                FOOTER = FOOTER & "DO NOT REPLY TO THIS EMAIL<BR>"
            FOOTER = FOOTER & "</font>"
        
        FOOTER = FOOTER & "</BODY>"
        
        FOOTER = FOOTER & "</HTML>"
        
        e.HTMLbody = e.HTMLbody & FOOTER
        
        'recipients
        Dim ee_em_co As Integer
        Dim lm_em_co As Integer
        ee_em_co = Application.WorksheetFunction.Match("username", Sheets(s1).Range("1:1"), 0)
        lm_em_co = Application.WorksheetFunction.Match("sts_linemgr", Sheets(s1).Range("1:1"), 0)
        e.Recipients.Add Sheets(s1).Cells(rw, ee_em_co) & "@somewhere.com"
        e.Recipients.Add "[email protected]"
        If sev >= 2 Then e.Recipients.Add Sheets(s1).Cells(rw, lm_em_co) & "@somewhere.com"
        If sev >= 3 Then
            e.Recipients.Add "a.n.other"
            e.Recipients.Add "a.n.other"
        End If
        
        'send mail or save as draft if off line
        If UCase(SENDIT) = "SEND" And e_usr = "FD2" Then
            e.send
        Else
            e.Save
        End If

Display More

the mail object is obviously e ... setting to Save rather than Send will post to your draft folder rather than actual mailing it.

lasw10 · Jul 11th 2005

Re: Button Size as s Cell Size?

Here's a quick bit of code which resizes a control according to the dimensions of a cell you refer to ...

Should point you in the right direction

Code

Sub a()


Dim s1 As String
Dim I1 As String
Dim w As Double
Dim h As Double


s1 = "Sheet1"   'name of sheet you wish to use...
Sheets(s1).Select


10
e = 0
I1 = InputBox("Which Cell Do You wish to use as size template?  Enter as cell ref = ie A1", "Cell Dimension", "A1")
If I1 = Cancel Then GoTo 10
On Error GoTo InvalidRange:
With Range(I1)
    w = .Width
    h = .Height
End With
If e = 1 Then GoTo 10


Dim obj As Object
For Each obj In ActiveSheet.OLEObjects
If obj.OLEType = 2 Then
    With obj
        .Width = w
        .Height = h
    End With
End If
Next obj


Exit Sub


InvalidRange:
MsgBox "Invalid Cell Reference Entered", vbCritical, "Error"
e = 1
Resume Next


End Sub

Display More

lasw10 · Jul 4th 2005

Re: Opening xl Hangs My PC - Critical Memory

Hmm, I can't recall the exact folder location on Win98 but try and find the folder within your profile entitled Olk.... (something along those lines) - may be within the WinNT folder if there's one on 98

MS Office sometimes caches your XL files (full size) and if you don't clear that it can cause *issues*

I will root around - think I posted something on Mr Excel a whilst back on this (under lasw10 pseudonym).

lasw10 · Jun 25th 2005

Re: Percentage Variance

er I might be reading this wrong but is it not simply

=(Base Cap Count - Gap Score) / Base Gap Count

Format Cell as %

lasw10 · Jun 25th 2005

Re: TIMESHEET - Public Holiday Exclusion/Inclusion?

why not use the networkdays formula (which can hold an array of public holiday dates)

see:

http://support.microsoft.com/?kbid=259200

basically run a test of how many workdays between the date and date (ie use date as start and end) excluding the array of public holidays - if the answer is 0 then you know it's a public holiday right?

lasw10 · Jun 25th 2005

Re: Notify new data has been added

to give an example of what I mean for point 3...

the bat file itself would look something like this - (to generate a message box on your desktop whenever a record was added)

Code

:Begin
net send NAMEOFYOURMACHINE "Record Added to Database"
:Exit

This is the ASP code (found this at Experts Exchange re: calling a .bat file from asp page... untested... obviously the path would need to be changed to reflect it's correct lcoation) ...
You would put this code immediately after the code that amends the db...so when the update db command runs in asp it then runs this to generate the message to you...

Code

<%
Set oWSH= Server.CreateObject("WScript.Shell")
oWSH.Run "c:\\netsend.bat", 1, True
set oWSH = nothing
%>

This is all untested, an email solution would still be best but should never write off the simpler things in life...

lasw10 · Jun 25th 2005

Re: Notify new data has been added

OK my points would be as follows:

1. If this is a work thing then you should be able to get access to your mail server from your IT dept - ie just get them to tell you the address of the server.
Your options then are to either hardcode the mailhost address into your asp page (using something like ASPmail - I've not coded in ASP for a while but I will have some code lying around somewhere... I've been converted to the .Net suite) - using some reliable 3rd party mail object model means it will queue properly etc should the mail server become unavailable.. OR alternativerly use localhost but configure IIS localhost to use a smarthost to your given mailserver (from IT) - this is maybe the cleaner option.

2. If you didn't necessarily need to receive an email when someone posted to your db you could simply i) create a new table in your .mdb which logs the db activity or ii) add a timestamp field to your current db table - so when the record is added you have a timestamp as to when it was added. You could then build another .asp page which retrieves the log and shows when records have been added - you could use a meta refresh (not great but workable) to constantly refresh the page all day for you.

3. This one's out of leftfield.... you could create a .bat file that utilises NetSend in DOS and run it from your asp page when the .mdb is written to... netsend is used for popping up messages on your machine on a network (like an IT announcement when email is down). Have to confess that I've never tried this from a web page but my guess is it's not too difficult. To do this you would just need to know your machine's name so it can be called in the netsend.

Or we can look into using VB in MS Access referencing OL to send you a message but I don't have MS Access on my machine anymore (blast!)

We will actually answer your question soon.... I promise!

lasw10 · Jun 24th 2005

Re: Loop does not work well

the problem you're having is that you're iterating and specifying a range that will actually change once a row is deleted... ie if you delete a6 - a7 becomes a6 - but your code jumps to a7 instead of checking a6 again.... you could put in a "goto" instead of "next c" in these instances but you will still end up cycling through lots of unnecessary cells.