Posts by pdsasse

Re: Calculate Date Differences: Time in & Time Out

you can just subtract the two values.
if 12/11/2010 10:09 is in A1
and
12/12/2010 11:00 is in A2
the formula would just be =A2-A1

The trick is in how the result is formatted. It may come back as 1.035416667 or when I did it, the default format in the cell with the formula displayed the result as 1/1/1900 0:51.

To get it to display 24:51, you just have to change the format of the cell with the formula.
Set it to a custom format of [hh]:mm and it will display as you want it to.

If you don't know how to do a custom format. Right click on the cell. Choose format cells
Select the Number tab
Choose Custom from the Category.
On the right below where it says Type:, input the [hh]:mm and click OK.

Re: Closed Workbook Still Showing in VBE

the window is actually still open. The web page loads it into an internet explorer window...

You can activate it and view it. You can even use code to retrieve and change values in the workbook by doing wb.worksheets(1).range("a1").value = etc......

But if you do wb.close, it doesn't close...

and even after trying to close it can still do...
debug.print wb.worksheets(1).range("a1").value and it will pull values from the workbook...

My colleageu figured out to loop through windows collection of open windows and looked for a Window with the URL of the workbook window, and closing the window that way... (see code below)

that was the only way he could get it to close. We were able to resolve the issue that way, but if anyone has any ideas why wb.close didn't work, I would love to hear them...

Dim objShell, ObjShellWindows, objW


    Set objShell = CreateObject("Shell.Application")


    Set ObjShellWindows = objShell.Windows


 


    For Each objW In ObjShellWindows
' Modified the URL, cause it's company confidential.
        If objW.LocationURL Like "www.ozgrid.com" & "*" Then


            objW.Quit


                End If


        Next

Good day Ozgrid.

I and a colleague are working on some code to automate a web page. We've been able to get it to fill in the needed forms, run a report which comes out in Excel format and save the output to a specified shared drive location.

However, when we attempt to close the resulting window we are unable to...

The webpage creates a new Internet explorer window which we're able to capture and do a wb.saveas, but when we do wb.close, it does not generate an error, but the new window does not close.

In the VBE, the workbook is visible as an object, but in Excel if you go to Windows on the main menu and attempt to select it, it's not listed and the Unhide option is greyed out.

So the object is a member of the workbooks collection for the VBE, but not Excel...

I'm really stuck on being able to close this window...

If anyone has any ideas, I would greatly appreciate the help.

I'm sorry, I can't post the code because it's pulling data from a web page with company proprietary information on it...

Re: Hyper Linking

Excel has a hyperlink function which you can use to build a hyperlink based on the value of a cell.

The syntaxt is Hyperlink(FileLocation, TextToDisplay)

I've attached an example. I placed two text files on my desktop, one named 1.txt and one is 2.txt...

In column A of the spreadsheet i just have 1 - 8... In column B I wrote the formula to create the hyperlink for the first two files. If you have 1-8 saved on your desktop, you could just fill the formula down and your hyperlink to each file is built for you.

this could easily be implemented for a few thousand hyperlinks....

Re: Copy Large Formulas Without Changing Ranges

You can also do this by hand if you're only needing to do a few, just by going into the interior of the cell and copying the formula. Then go into the interior of your destination cell and paste the formula.

To go into the interior of the cell, click inside the formula bar...

If you have a handful of formulas to copy over, I like to use the notepad. Copy your handful of formulas into notepad. Then you can copy the formula from there into your destination cell without having to go back and forth etc...

Also, if you use concrete ranges in your formulas, you can often avoid having to do this all together...

Re: Average Pertaining To Text Entries

assuming your letters are in column A and your values are in Column B below is the formula to get the average value for "R" rows.

=SUMIF(A:A,"R",B:B) / COUNTIF(A:A,"R")

Re: Copy Worksheet From One Workbook To Another

You can use a similar method to refer to an already opened WB...

you only have to change 1 line from the example I gave in my last post...

Change

Set Wb = Workbooks.Open(Filename:= _ 
    "C:\Documents and Settings\dt64864\Desktop\Test\" _     & OpenFileName)

to

Set Wb = Workbooks(OpenFileName)

Re: Assign An Open File A Name Then Activate Window

Why not try something like this...
You can set a variable equal to the workbook, and then your subsequent code can refer to the variable as if it were the workbook. Then you can perform whatever actions you need to with that workbook. The Test() sub prompts the user to enter the date they want to open. Then it passes that date to the Example function. This function then formats the date correctly and opens the appropriate file assigning that workbook to a workbooks variable named Wb. Then you can do whatever you need to do to that Wb.

Function Example(FileDate As Date)
Dim Wb As Workbook
Dim Ws As Worksheet
Dim OpenFileName As String


OpenFileName = "xlRepLog" & _
    Format(FileDate, "yyyymmdd") & ".xls"




Set Wb = Workbooks.Open(Filename:= _
        "C:\Documents and Settings\dt64864\Desktop\Test\" _
        & OpenFileName)
With Wb
'below is sample code to copy column 1 from the first worksheet
'of the WB add a new worksheet and paste it to column 1 of the new
'worksheet....
'Replace this code with all the actions you need done on the workbook once it's
'opened.


    .Activate
    .Worksheets(1).Activate
    Range("A1").EntireColumn.Copy
    .Worksheets.Add
    .Worksheets(Wb.Worksheets.Count).Activate
    Range("a1").Activate
    
    ActiveSheet.Paste


End Function


Sub Test()
Dim FileDateToOpen As Date


FileDateToOpen = DateValue(InputBox("Enter the date you want to open"))


Example FileDateToOpen
End Sub

Re: Copy Worksheet From One Workbook To Another

Sorry about that...

So this WB is always in the same directory???

If so something like....

Function Example(FileDate As Date)
Dim Wb As Workbook
Dim Ws As Worksheet
Dim OpenFileName As String


OpenFileName = "Overdue Ordersdate " & _
    Format(FileDate, "mm-dd-yy") & ".xls"




Set Wb = Workbooks.Open(Filename:= _
        "C:\Documents and Settings\dt64864\Desktop\Test\" _ ' replace with your files location
        & OpenFileName)
        
with Wb
     'do what you need to with the file...


End with


End Function


Sub Test()
Dim FileDateToOpen As Date


FileDateToOpen = DateValue(InputBox("Enter the date you want to open"))


Example FileDateToOpen
End Sub

this will open the file you need and then you can do whatever you need to with that file from there...

Re: Copy Worksheet From One Workbook To Another

There are a number of ways to do this.

If the tab is always the first tab in the WB, or always the last tab in the WB, you can use the index of the tab...

You could use the Left function to search in the first X charectars of the tab name...

Below are three Sub that demonstrate 3 methods you might be able to use.

Sub FirstSheet()
Worksheets(1).Move Before:=Workbooks("Book1").Sheets(1)


End Sub


Sub LastSheet()
Worksheets(Worksheets.Count).Move Before:=Workbooks("Book1").Sheets(1)


End Sub




Sub FirstXCharectart()
Dim Ws As Worksheet


For Each Ws In ThisWorkbook.Worksheets
    Select Case Left(Ws.Name, 15)
    Case "over due orders"
        Ws.Move Before:=Workbooks("Book1").Sheets(1)
    Case Else
    End Select
    
Next Ws


End Sub

Re: Creating A Macro To Extract Data From A Worksheet Then Save To A New File

Try something like...

Sub ExportTab()
Dim Wb As Workbook
Dim Ws As Worksheet
Dim SaveFileAs As String


ThisWorkbook.Worksheets(1).Copy
Set Wb = Workbooks(Workbooks.Count)
Wb.Activate
Set Ws = Wb.Worksheets(1)
'make your modifications to the new WB here...
With Ws
    .Activate
    .Range("B:B,F:F").EntireColumn.Delete
    
End With
'prompt user for new location/filename, or replace Application.GetSaveAsFilename with a static filename/location


SaveFileAs = Application.GetSaveAsFilename
If Not SaveFileAs = "False" Then Wb.SaveAs SaveFileAs






End Sub

Re: Pastespecial/autofill With File Links

try using..

application.Calculation = xlCalculationManual

This should suppress Excel trying to calculate each time an edit is made to a formula...

however, keep in mind that this setting is persistent.

By this I mean that when you close the WB you're working in the setting will remain in effect until you change it back again.

This can cause undesirable effects at times, but it should keep Excel from trying to resolve the external links at the time you paste the formula down to other cells.

Re: Conditional Selection Of Hidden And Unhidden Columns

replace selection.copy with

Selection.SpecialCells(xlCellTypeVisible).Copy

that tells excel to only copy the cell if it is visible.

This same method can be used when auto-filter is being used to only get cells visible based on the current filter applied.

Re: Prevent Saving Certain Worksheets On Save As

Something like this???

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    Dim p As String
    Dim Wb As Workbook
    Dim SaveAsFile As String
    Cancel = True
    Do While Cancel = True
        p = InputBox("Enter   password to  save file:", "Password Required To Save", "")
        If p = "bob" Then
            Sheets(Array("Sheet6", "Sheet5", "Sheet4")).Copy
            Set Wb = Workbooks(Workbooks.Count)
10
            SaveAsFile = Application.GetSaveAsFilename
            If SaveAsFile = "False" Then GoTo FalseSave
Application.EnableEvents = False
Application.DisplayAlerts = False
            Wb.SaveAs SaveAsFile
Application.DisplayAlerts = True
Application.EnableEvents = True
Exit Sub
            Cancel = False
        Else
            yn = MsgBox("Wrong password. Try again?", vbYesNo, "Invalid Password")
            If yn = vbNo Then
                Exit Sub
            End If
        End If
     Loop
Exit Sub
FalseSave:
Application.DisplayAlerts = False
            Wb.Close
Application.DisplayAlerts = True
End Sub

Instead of going on with the normal SaveAs procedure, it copies only the listed tabs into a new WB and saves it to the location the user selects...

The process should be pretty transparent to the user....

Re: Copy Cell To Another Cell Based On Strict Criteria

I wouldn't do this with a macro if it were me. I would use the advanced filter feature of MS Excel to create a unique list of account numbers in another column somewhere on your WB.

Then use a sumproduct formula to determin which account numbers don't have the ta usage code at leaset once.

see attached WB for an example of the formula I would use... then you can autofilter for all the accounts with 0 instances of ta...[hr]*[/hr] Auto Merged Post;[dl]*[/dl]If you want to use VBA for this. I would use something like...

Sub GetNotaS()
Dim InVals()
Dim OutVals(60000, 0)
Dim TaCount
Dim InCount As Long, OutCount As Long




Worksheets(1).Activate


'LOAD values from columns a and b into your array variable InVals
InVals = Range("a2:b" & Range("b65536").End(xlUp).Row).Value






'Loop through the values and find account numbers with no ta usage types
For InCount = 1 To UBound(InVals) - 1
    'if the usage type for this entry is ta, add 1 to your ta count
    If InVals(InCount, 2) = "ta" Then
        TaCount = TaCount + 1
    End If
    ' if this is the last instances of this account number then...
    If InVals(InCount, 1) <> InVals(InCount + 1, 1) Then
        ' if the tacount for this account number was zero, add it to your list of account numbers
        If TaCount = 0 Then
            'add the account number to your output array variable named OutVals
            OutVals(OutCount, 0) = InVals(InCount, 1)
            ' incriment the OutCount variable so that next time you add an account number
            'you're adding it to the next record of your OutVals variable
            OutCount = OutCount + 1
        End If
        ' reset your ta count before checking on the next account number
        TaCount = 0
    End If
    
Next InCount






Worksheets(Worksheets.Count).Activate
' place your list of account numbers into column A of the last worksheet in the wb
Range("a1:A" & OutCount).Value = OutVals




End Sub

see attached WB for a working example of this code in action.

Re: Insert Value To Spesified Row Until End

Try

Selection.AutoFill Destination:=Range("B2:B" & Range("A65536").End(xlUp).Row), Type:=xlFillDefault

in place of your problem line of code.

The Range("A65536").End(xlUp).Row line tells VBA to start at cell A65536 (the bottom cell in that collumn) and then go to the first cell above that with data in it. It's the same as selecting this cell yourself and doing a Control>Up Arrow...
Then use the row number of that cell as the end of your autofill destination range.

I hope that helps.

Re: Obtain Value Of A Sheet Within A Workbook

Good day. Welcome to Ozgrid. I use the following functions for automating the sending of eMail with Excell....

You can build your email body or HTML body to suite using this... This uses a function to convert a range into HTML. I use this to convert tables into formatted HTML that I can include in the body of an email so that it displays looking the same as it does in the source worksheet.

I got a lot of this code from http://www.rondebruin.nl/cdo.htm...

I am by no means an expert on using CDO to send email, but this code got me started and I figured it out using trial and error. But now it works great!!!

Sub SendeMail(Subject As String, Optional Attachment As String, Optional Rng As Range)
    Dim iMsg As Object
    Dim iConf As Object
    Dim strbody As String
        Dim Flds As Variant


    Set iMsg = CreateObject("CDO.Message")
    Set iConf = CreateObject("CDO.Configuration")


        iConf.Load -1    ' CDO Source Defaults
        Set Flds = iConf.Fields
        With Flds
            .Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
           
'SMTP server name goes below.
           .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") _
                           = "Your SMTP server name goes here"
            
            .Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25


' ***************** ' on our server at work, I comment out the following two lines _
            and it uses my credentials I signed onto the network with *************
            .Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = "Username"
            .Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "pw"
            .Update
        End With


    strbody = ""


    With iMsg
        Set .Configuration = iConf
        
        .To = "[email protected]; [email protected]"
        
        .CC = ""
        .BCC = ""
        .From = """Display name here"" <[email protected]>"
        .Subject = Subject
        If Not Rng Is Nothing Then
            .HTMLBody = RangetoHTML(Rng)
        End If
            
        If Attachment <> "" Then
            .addattachment Attachment
        End If
        
        
        .Send
    End With


End Sub


Function RangetoHTML(Rng As Range)
' Changed by Ron de Bruin 28-Oct-2006
' Working in Office 2000-2007
    Dim fso As Object
    Dim ts As Object
    Dim TempFile As String
    Dim TempWB As Workbook


    TempFile = Environ$("temp") & "/" & Format(Now, "dd-mm-yy h-mm-ss") & ".htm"


    'Copy the range and create a new workbook to past the data in
    Rng.Copy
    Set TempWB = Workbooks.Add(1)
    With TempWB.Sheets(1)
        .Cells(1).PasteSpecial Paste:=8
        .Cells(1).PasteSpecial xlPasteValues, , False, False
        .Cells(1).PasteSpecial xlPasteFormats, , False, False
        .Cells(1).Select
        Application.CutCopyMode = False
        On Error Resume Next
        .DrawingObjects.Visible = True
        .DrawingObjects.Delete
        On Error GoTo 0
    End With


    'Publish the sheet to a htm file
    With TempWB.PublishObjects.Add( _
         SourceType:=xlSourceRange, _
         Filename:=TempFile, _
         Sheet:=TempWB.Sheets(1).Name, _
         Source:=TempWB.Sheets(1).UsedRange.Address, _
         HtmlType:=xlHtmlStatic)
        .Publish (True)
    End With


    'Read all data from the htm file into RangetoHTML
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2)
    RangetoHTML = ts.readall
    ts.Close
    RangetoHTML = Replace(RangetoHTML, "align=center x:publishsource=", _
                          "align=left x:publishsource=")


    'Close TempWB
    TempWB.Close savechanges:=False


    'Delete the htm file we used in this function
    Kill TempFile


    Set ts = Nothing
    Set fso = Nothing
    Set TempWB = Nothing
End Function

Re: Sort Text And Digits Automatically

So are you given a .txt file with this data? If so, you can link Excel to a text file that is tab delimited. Then you can just save the new file somwhere, refresh your link (which will bring each data point into Excel in a different column for you). Then you can just copy and paste the cells from the desired column...

I've attached a text file that uses your sample data and is tab delimited..

also there is an excel file attached. Save them together in a directory somewhere.

On the 'Get New Data' tab, right click anywhere on the values you see and choose refresh data.
It will prompt you for the location of the text file.

Using this method, you can overwrite the NewData.txt file each time you get new data. Refresh the link in Excel and then just copy columns D:F. Or point your formulas to those cells...

If this doesn't help, let me know. There are also options using formulas to parse out only the data you need.

Re: Pull Inconsistent Data To Another Workbook

Check this line

If Cl.Interior.ColorIndex = 36 Then

Did you manually highlight the cells you wanted to keep in your example? or was that the raw report.

I wrote the macro assuming that the data you wanted would be in the yellow cells... So it only copies data from cells that have yellow shading.

Also, it could be that the colorindex is different on your machine for some reason.

On my machine when I opened your example, the color applied to the highlighted cells showed up as colorindex 36...

I would step throught the code (use F8) and see where the breakdown is...

Re: Insert Image Error

It sounds like either you're trying to insert an unsuported file type, or perhaps your instal of Excel is corrupt or doesn't have all the needed components to be able to do this.

If you have the MS Office disk, I would try using it to repair your instalation of Excel...

Is the image file a standard image type? (gif, jpg etc...)

Without being able to work off your workstation, those are my best guesses.