Posts by boombox

Hi!

I have an excel workbook 'managing' invoices for me.

I know Access would be better, but for various reasons it has to be Excel for the moment.

I have a macro which increments an invoice number and saves a PDF of the invoice.

I would like to populate two columns on a worksheet within the workbook where it keeps a record of the invoice number and the total amount it was raised for.

Could anyone help me achieve this? forum.ozgrid.com/index.php?attachment/46049/

Thanks!

P.S. DUMMY DATA IS USED TO PROTECT CUSTOMER INFO.

Re: Combining multiple workbooks with single sheets into one workbook with multiple s

I give up. Thank you for your time anyway!

Re: Combining multiple workbooks with single sheets into one workbook with multiple s

Thank you so much for the time you're taking on this. I tried the above with the sample data and got a new error:-

[Blocked Image: http://photoupload.org/uploads/13309601141.jpg]

Re: Combining multiple workbooks with single sheets into one workbook with multiple s

World's politest bump ever.

Re: Combining multiple workbooks with single sheets into one workbook with multiple s

Quote from cytop;597818

Works for me... Can you post an anonymous/cut-down copy of your workbook?

Please find attached

forum.ozgrid.com/index.php?attachment/44197/

And thank you!

Re: Combining multiple workbooks with single sheets into one workbook with multiple s

Thanks - but the code generates a type mismatch on

If LastCell.Value = vbNullString And LastCell.Row <= 2 Then

No problems if the more or less empty workbooks aren't in the target folder.

Re: Combining multiple workbooks with single sheets into one workbook with multiple s

Sorry about quoting posts. In another programming forum it's encouraged and common practice due to people deleting or editing posts. I shan't do it here!

I've tried to implement your check as you posted it, and got a type mismatch. When I tried to peg it on to the end of an existing IF, I get a type mismatch.

Any ideas?

Do Until FileName = ""
        If FileName <> ThisWB Then
            Set Wkb = Workbooks.Open(FileName:=path & "\" & FileName)
            For Each WS In Wkb.Worksheets
                    Set LastCell = WS.Cells.SpecialCells(xlCellTypeLastCell)
                    If LastCell.Value = "" And LastCell.Address = Range("$A$1").Address And LastCell.Row > 1 Then
                    Else
                        WS.Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
                    End If
                Next WS
                Wkb.Close False
            End If
        FileName = Dir()
    Loop

Thanks!

Re: Automatic shutdown issues with saving if someone's in the workbook and it's read-

Quote from jbell;597501

If a user opens the workbook when another user already has it open, are they getting prompted to open as 'Read Only'. It sounds like that might not be happening.
You could try picking up any errors when saving and handling them in code rather than getting the ugly VBA default errors. (Code Below)

This works beautifully, I think. Thank you!

Re: Combining multiple workbooks with single sheets into one workbook with multiple s

Thanks, this prompted me to look at my data. Two workbooks only had data on row1. Adding data to row2 resolved the error. I've no idea how to add error checking for that. I don't these particular workbooks merged (row 1 is a header row, so the workbook is effectively empty) but it would be nice for the code not to fail is there is no row2.

Otherwise, I'm still looking for a way to store the code in personal but perform/store the merge in a new workbook.

THANKS!!

Re: Combining multiple workbooks with single sheets into one workbook with multiple s

Polite bump!

Re: Refer to workbook by beginning of filename (as end changes)

That worked a treat! Thanks

I am trying to use this code. It has worked very well in the past but has stopped working for some reason.

Here is mine code:-

Option Explicit
 
 '32-bit API declarations
Declare Function SHGetPathFromIDList Lib "shell32.dll" _
Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal _
pszpath As String) As Long
 
Declare Function SHBrowseForFolder Lib "shell32.dll" _
Alias "SHBrowseForFolderA" (lpBrowseInfo As BrowseInfo) _
As Long
 
Public Type BrowseInfo
    hOwner As Long
    pIDLRoot As Long
    pszDisplayName As String
    lpszTitle As String
    ulFlags As Long
    lpfn As Long
    lParam As Long
    iImage As Long
End Type
 
Function GetDirectory(Optional msg) As String
    On Error Resume Next
    Dim bInfo As BrowseInfo
    Dim path As String
    Dim r As Long, x As Long, pos As Integer
     
     'Root folder = Desktop
    bInfo.pIDLRoot = 0&
     
     'Title in the dialog
    If IsMissing(msg) Then
        bInfo.lpszTitle = "Where those files at?"
    Else
        bInfo.lpszTitle = msg
    End If
     
     'Type of directory to return
    bInfo.ulFlags = &H1
     
     'Display the dialog
    x = SHBrowseForFolder(bInfo)
     
     'Parse the result
    path = Space$(512)
    r = SHGetPathFromIDList(ByVal x, ByVal path)
    If r Then
        pos = InStr(path, Chr$(0))
        GetDirectory = Left(path, pos - 1)
    Else
        GetDirectory = ""
    End If
End Function
Sub CombineC2GFiles()
    Dim path            As String
    Dim FileName        As String
    Dim LastCell        As Range
    Dim Wkb             As Workbook
    Dim WS              As Worksheet
    Dim ThisWB          As String
     
    ThisWB = ThisWorkbook.Name
    Application.EnableEvents = False
    Application.ScreenUpdating = False
    path = GetDirectory
    FileName = Dir(path & "\*.csv", vbNormal)
    Do Until FileName = ""
        If FileName <> ThisWB Then
            Set Wkb = Workbooks.Open(FileName:=path & "\" & FileName)
            For Each WS In Wkb.Worksheets
                Set LastCell = WS.Cells.SpecialCells(xlCellTypeLastCell)
                If LastCell.Value = "" And LastCell.Address = Range("$A$1").Address Then
                Else
                    WS.Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
                End If
            Next WS
            Wkb.Close False
        End If
        FileName = Dir()
    Loop
    Application.EnableEvents = True
    Application.ScreenUpdating = True
     
    Set Wkb = Nothing
    Set LastCell = Nothing
End Sub

I've modified it to combine CSV files.

Now, it breaks and says 'type mismatch' on this line:

If LastCell.Value = "" And LastCell.Address = Range("$A$1").Address Then

Aside from that, I'd like to install this in my personal macro workbook - but have the "result" (the combined workbook) in a new, blank workbook.

Any tips?

THANKS!

Every day I run a macro.

Every day the macro leaves open a source file (it copies info into a new workbook).

I can't reliably close the source file within the Macro because the source file has a naming format like

VendorBacklog4343242343 (the numbers aren't a date or anything I can predict). Today's was 82435386 - which I hoped might be Unix time, but this is 1972 in Unix time.

Anyway I can refer to the file as "filebeginning(VendorBacklog).close" or some such?

THANKS

Re: Automatic shutdown issues with saving if someone's in the workbook and it's read-

Quote from jbell;597144

Try the following in place of ThisWorkbook.Save

Code

If ThisWorkbook.ReadOnly Then
    ThisWorkbook.Saved = True
Else
    ThisWorkbook.Save
End If

Sounded amazing, but doesn't work. The user is now prompted to save when exiting.

Any other ideas?

Re: Automatic shutdown issues with saving if someone's in the workbook and it's read-

oo that sounds fruity, thanks! I'll try it

Re: Automatic shutdown issues with saving if someone's in the workbook and it's read-

Anyone? Thanks

Re: Determine if Excel workbook exists in VBA and if it doesn't find the newest itera

Excellent! Thank you!

Hi
I use the following code to automatically close the workbook after a period of inactivity. It's very much based on the work of others, but I think an improvement, because it works flawlessly (with caveat below) and is simple to implement.
The problem is if someone else was IN the workbook when the user opened it, the code still tries to save it when they exit, causing all sorts of problems because it can't, so it just plonks a copy of the workbook somewhere in the network share. And it shows an ugly error to the user.
User Module

Dim DownTime As Date
Sub SetTime()
DownTime = Now + TimeValue("00:7:00")
Application.OnTime DownTime, "ShutDown"
End Sub
Sub ShutDown()
Sheet37.Activate
ThisWorkbook.Save
ThisWorkbook.Close
End Sub
Sub Disable()
On Error Resume Next
Application.OnTime EarliestTime:=DownTime, Procedure:="ShutDown", _
Schedule:=False
End Sub

ThisWorkbook

Private Sub Workbook_Open()
Call Disable
Call SetTime
    Dim strFullFilename As String
    Dim OPENORNOT As Boolean
    strFullFilename = "O:\boombox\Information.xlsm"
    If (GetAttr(strFullFilename) And vbReadOnly) = 1 Then
        OPENORNOT = True
        MsgBox "Another user has info open."
        Else
        'MsgBox "You CAN save this file!"
    End If
End Sub
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Sheet37.Activate
ThisWorkbook.Save
Call Disable
End Sub
Private Sub Workbook_SheetCalculate(ByVal Sh As Object)
Call Disable
Call SetTime
End Sub
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target _
As Excel.Range)
Call Disable
Call SetTime
End Sub

I tried to add IF statements using the boolean variable OPENORNOT to only "Thisworkbook.save" if the answer was FALSE, but that didn't work at all. Any tips? Anyone care to try this out a bit?

THANKS!!

Sub Button1_Click()
Config = vbYesNo + vbQuestion + vbDefaultButton2
Ans = MsgBox("Crank it?", Config)
If Ans = vbYes Then
     Workbooks.Open "C:\boombox\" & Format(Date, "dd.mm.YYYY") & ".xlsx"
   
ElseIf Ans = vbNo Then
    
End If
End Sub

Hi,

I was wondering about a way to modify this code to either
1) Find out if the workbook exists, and if it doesn't, return an error
OR EVEN BETTER
2) If it doesn't, go back in time day by day until a workbook DOES exist.
i.e. Workbooks.Open "C:\boombox\" & Format(Date, "-1dd.mm.YYYY") & ".xlsx"
or
Workbooks.Open "C:\boombox\" & Format(Date, "-2dd.mm.YYYY") & ".xlsx"

THANK YOU

Hi

Every day I run a macro:-

Sub CopyFromALR_To_Matcher()
    Application.CutCopyMode = False
'Copy PO
    Windows("16.12.11 Bob ALR.xlsx").Activate

there's more code than that, but I've copied only the relevant bit.

Basically I'd like to say

Windows(Today() & "Bob ALR.xlsx").Activate

or something, instead of having to modify the VB every day.

Anyone know if this is possible? I have Googled...

Thanks!