Posts by lasw10

Re: SUMIF - restricted

ah, ok, no way of doing this without using SUMPRODUCT?

Re: Fill combobox with multiple columns

do you not just need to adjust the bound columns property of the combo box to be = to no. of columns you're filling it with?

if you're filling with VBA can you post your code.

Feel a bit stooopid asking this (as most of you know I only answer....)

I've seen examples in the past but I can't find anything when I need it...

Say I have a worksheet called "DATA" with 2 columns A & B
In Column B I have numbers I wish to sum.
In Column A I have a string of variable length...

eg

abcde
abc
abx
abf

Now let's say on another sheet called "CALCS" I also have 2 columns A & B

in A I have
abc
abx
abf

in Col B i want a sumif that sums "DATA" Column B where "DATA" Left(Column A,3) = abc - ie I only want to test against left 3 characters.... or more specifically "abc" (could be "ab" for arguments sake) ... how do I do that?

Ta

Re: Date Formatting

if the date were say 1st July would your system return 070105 or 07105?

presuming former - just convert your returned string to a date by manipulating the string itself rather than trying to convert direct to date

ie

Dim d As String
d = "072205"  'this would be referenced to your variable and not hardcoded as it is here


Dim d1 As Date
d1 = CDate(Mid(d, 3, 2) & "/" & Left(d, 2) & "/" & Right(d, 2))


Cells(1, 1) = d1

Re: Daily updated information placed in cells by month

no there's no formula - you would have to via VBA ... if you used formulas it would be impossible for you to maintain the prior day's data (and all data prior to today) ... the only way to do what you want is to copy the value from Sheet1 to the appropriate cell in the "Suggested Layout" sheet.

I have inserted a macro contained in Module 1 ... here is the code...

Sub update_daily()
Dim rw As Integer
rw = Application.WorksheetFunction.Match(Sheets("Sheet1").Cells(6, 22), Sheets("Suggested_Layout").Range("A:A"), 0)
Sheets("Suggested_Layout").Cells(rw, 4) = Sheets("Sheet1").Cells(44, 21)
ActiveWorkbook.RefreshAll
ActiveWorkbook.Save
End Sub

if you were to automate this file in full - ie open, get webdata, update 12 month data, update report etc... you would run the above via a change event - ie once the web data had been downloaded.

I use a similar type event for a currency_matrix I populate daily... i may post that code up to so you can get the gist for how that kind of thing is done (by me anyways!!)

eg....

first a workbook_open event to fire off when the workbook is opened ... and to retrieve data from a website (via a stored webquery within the file).... this file is opened via a Windows Schedule event... and run via an automated network account whereusername = "FD2"... so when opened by the automated account it fires off the routine "DAILY_DATA" and then closes the file... if opened by anyone else it just present with a message.

Private Sub Workbook_Open()
cuser = Environ("username")
If UCase(cuser) = "FD2" Then
    DAILY_DATA
    ActiveWorkbook.Close SaveChanges = False
Else
    MsgBox "This File is Automatically Scheduled to Run at 10am and 1pm on " & _
            "TOPCAT. " & vbLf & vbLf & _
            "Please ensure you do not have this file open at these times!", vbInformation, "Auto Schedule"
End If
End Sub

so presuming run by the FD2 account (ie is being automated) it then runs this code to actually update the data...

Sub DAILY_DATA()


Dim md As Date
QE = 0


'Clear Old Data
Sheets("DAILY").Select
Range(Cells(1, 1), Cells(65536, 2)).ClearContents
Cells(1, 1).Select


'Put in Error Handler - if query won't refresh then continue looping until it does!
10
QE = 0
On Error GoTo QueryError:
Selection.QueryTable.Refresh BackgroundQuery:=False
If QE > 0 Then GoTo 10


Do Until Cells(54, 2) <> ""
    Cells(1, 1).Select
    Selection.QueryTable.Refresh BackgroundQuery:=False
Loop


'LOAD MATRIX INFO TO DB
Dim MyConn As ADODB.Connection
Dim MyRS As ADODB.Recordset
Set MyConn = New ADODB.Connection
MyConn.Open "MYSQL_EXP"


'Remove existing data for today and tomorrow
MySQL = "Delete From currency_matrix where date >= '" & _
        Year(Now) & "-" & Month(Now) & "-" & Day(Now) & "'"
Set MyRS = MyConn.Execute(MySQL)


n = 2
Do Until Cells(n, 5) = ""
On Error GoTo Problemo:
    'Insert today
    MySQL = "Insert into currency_matrix values (" & _
            "'" & Cells(n, 3) & "', " & _
            "'" & Cells(n, 4) & "', " & _
            "'" & Year(Now) & "-" & Month(Now) & "-" & Day(Now) & "', " & _
            Cells(n, 5) & ", " & _
            Cells(n, 6) & ", " & _
            Cells(n, 7) & ", " & _
            Cells(n, 8) & ", " & _
            Cells(n, 9) & ", " & _
            Cells(n, 10) & ", " & _
            Cells(n, 11) & ", " & _
            Cells(n, 12) & ", " & _
            Cells(n, 13) & ", " & _
            Cells(n, 14) & ", " & _
            Cells(n, 15) & ", " & _
            Cells(n, 16) & ", " & _
            Cells(n, 17) & ", " & _
            Cells(n, 18) & ", " & _
            Cells(n, 19) & ", " & _
            Cells(n, 20) & ", " & _
            Cells(n, 21) & ")"
    Cells(n, 22) = MySQL
    Set MyRS = MyConn.Execute(MySQL)
    
    md = DateValue(Now + 1)
    'Insert tomorrow
    MySQL = "Insert into currency_matrix values (" & _
            "'" & Cells(n, 3) & "', " & _
            "'" & Cells(n, 4) & "', " & _
            "'" & Year(md) & "-" & Month(md) & "-" & Day(md) & "', " & _
            Cells(n, 5) & ", " & _
            Cells(n, 6) & ", " & _
            Cells(n, 7) & ", " & _
            Cells(n, 8) & ", " & _
            Cells(n, 9) & ", " & _
            Cells(n, 10) & ", " & _
            Cells(n, 11) & ", " & _
            Cells(n, 12) & ", " & _
            Cells(n, 13) & ", " & _
            Cells(n, 14) & ", " & _
            Cells(n, 15) & ", " & _
            Cells(n, 16) & ", " & _
            Cells(n, 17) & ", " & _
            Cells(n, 18) & ", " & _
            Cells(n, 19) & ", " & _
            Cells(n, 20) & ", " & _
            Cells(n, 21) & ")"
            Cells(n, 22) = MySQL
    Set MyRS = MyConn.Execute(MySQL)
        
n = n + 1
Loop


Exit Sub


QueryError:
QE = 1
Resume Next


Problemo:
Cells(n, 23) = Err.Description
Resume Next


End Sub

here it loops until it has successfully retrieved the required data from the web query ....

the rest you can ignore (its just loading data from various cells to a MySQL db for the current day & next)

in your case you'd simply replace all that bumpf with the code that copies the cell you want to the next blank cell... (as per the first bit of code I put up)

anyway - that's the general approach....

for others reading this... I wrote the code a long time ago so undoubtedly there are tweaks... but as it takes less than about 5 seconds to run in full I am not that fussed

Re: Daily updated information placed in cells by month

ZMERC - I am not being critical but trying to do what you want with the layout you have on sheet "12 Month Average" is really not great... it is possible to find the appropriate cell but it's certainly not as straightforward as it should be.

I think you need to really decide if you can amend the format of the 12 month average sheet so it is laid out in a logical fashion...

I have attached an ex. of what I mean.

I've taken the liberty of putting in a very simplistic piece of code you could use to update your 12 month data ... if you're updating the webdata remotely then you could put this in the sheet event for the datarefresh but we'd need to see the code you're using - or a snippet thereof.

Re: Error in code, not sure where?

sorry for delay ... my contributions are sadly sporadic thesedays because of work.

Ok ....

1. Being saved to MyDocuments because my code contains typo - "Folder" should be "Foldername" as per your variable.

2. Still slightly confused about when you open the file... suppose OSI in row 2 is XYZ - you open the template, copy and save the data etc in DISCRETE... if OSI in row3 = XYZ what do you do? Are you ignoring whatever is in Row 3 (given the line if cells(i,2) = "" then....) implies that you do ignore duplicate OSIs... and only create a new file when you reach a new OSI. can you confirm this... simple to remedy.

3. As for the sheet print code - Workbooks(wb).Sheets(1).PrintOut should work.

Re: Workbook Variable

because Jane is not the file name - it is Jane N whereas for the other users you could just use the user variable.

Re: Error in code, not sure where?

actually this line is confusing....

If Workbooks(wb).Sheets(1).Cells(i, 2).Value <> "" Then 'If line is empty insert there

should be...

If Workbooks(wb).Sheets(1).Cells(i, 2).Value = "" Then 'If line is empty insert there

Re: Error in code, not sure where?

reason it's not copying is because of an error in my code - when it does the first check to see if the cell is not blank it's checking the wrong file - should be DisWB and not wb ... wb is the newly created blank file.

as for the workbook.close thing - when would you want to close the workbook...

i am not sure that part of the code is structured correctly - depends on when you need to open and save the new DISCRETE file ... and then when you want to close it ... can you elaborate.

Re: Daily updated information placed in cells by month

ok I think i can see what you;re trying to do now but have one question...

the sheet 12 month average - is that for just one Region (from Sheet1)

else I can't work out where the number being added for each day comes from.

as a pointer....

I think you might find it easier to store the data in almost database format...

that is 12 Month Average Sheet as follows:

Column A: Date
Column B: Weekday
Column C: Month (if nec.)
Column D: Number

Then run a pivot table off this data to give you the nice layout you want - with average of course for each month.

Regardless of the pivot - doing the above layout will make your life much simpler in the long run - ie if you had to you could scrap the idea of Pivot and just have another sheet which showed you the average by weekday for each month.

Let us know your thoughts... and also explain the numbers to us on 12 month avg sheet ... that's the only bit I can't follow.

Re: Workbook Variable

OK I would define as string

I would also use a SELECT CASE rather than lots of IFs (more efficient)

also as all files nearly identical you could create a mainstay variable and then have a minor exception

eg

Public Sub CopySapData() 


    Dim SapF As String 
    user = sapform.UserBox.Text 
sapF = "G:\5762x-Reconciliation\57621-LON Reconciliation\Brokerage\SAP Files 2005\SAP DAILY-UPLOAD - "


Select Case UCase(user)
Case "JANE"
    SapF = Sapf & " Jane N.xls"
Case Else
    Sapf = Sapf & user & ".xls"
End Select


Workbooks.Open(sapf)
End Sub

Re: Error in code, not sure where?

Sub BuildDiscrete()
     
    Dim c As Range 'Loop variable for total lines
    Dim i As Integer 'Loop variable for discrete creation
    Dim wb As String 'Workbook of current discrete in creation
    Dim Diswb As String 'Workbook containing all values to create with
    Dim todate As String 'Date to use in file saving/opening
    Dim Foldername As String 'Pathname where files saved
    Dim Filename As String 'Name to save wb
    Dim OsiNum As String 'OSI number of current line
    todate = Format(Date, "mmddyy") 'Format Today() as specified
    Diswb = ActiveWorkbook.Name  'Set Diswb
    Foldername = "V:\SHARED\COMMON.P13\PROGRAMS\GE\Kelli\My Documents\DISCRETES\DISCRETES FOR 2005\"
    For Each c In Range("G:G") 'Loops using each value in row G
        OsiNum = c.Value 'Sets OsiNum for current line
        Filename = "DISCRETE" & "_" & todate & "_" & OsiNum & ".xls" 'Creates filename to be used
        If IsWorkbookOpen(Foldername & Filename) Then 'Check if Filename is already created
            wb = Filename 'Pointless line, wb already equals Filename
        Else
            wb = Filename
            Workbooks.Open "V:\SHARED\COMMON.P13\PROGRAMS\GE\Kelli\My Documents\DISCRETES\DISCRETE_CHANGES_OSI Form.xls" 'Blank form for new Discrete
            ActiveWorkbook.SaveAs Folder & Filename 'Saves under proper filename
            'wb = ActiveWorkbook.Name 'Sets to active book
            Workbooks(wb).Sheets(1).Cells(5, 4).Value = Workbooks(Diswb).Sheets(1).Cells(c.Row, 6).Value 'Cells filled in upon creation
            Workbooks(wb).Sheets(1).Cells(6, 4).Value = Workbooks(Diswb).Sheets(1).Cells(c.Row, 7).Value  'Cells filled in upon creation
        End If
        For i = 15 To 27 'Lines where data is entered
            If Workbooks(wb).Sheets(1).Cells(i, 2).Value <> "" Then 'If line is empty insert there
                Workbooks(wb).Sheets(1).Cells(i, 2).Value = Workbooks(Diswb).Sheets(1).Cells(c.Row, 10).Value 'All these are data insertions
                Workbooks(wb).Sheets(1).Cells(i, 3).Value = Workbooks(Diswb).Sheets(1).Cells(c.Row, 1).Value
                Workbooks(wb).Sheets(1).Cells(i, 4).Value = Workbooks(Diswb).Sheets(1).Cells(c.Row, 5).Value
                Workbooks(wb).Sheets(1).Cells(i, 5).Value = Workbooks(Diswb).Sheets(1).Cells(c.Row, 9).Value
                Workbooks(wb).Sheets(1).Cells(i, 6).Value = Workbooks(Diswb).Sheets(1).Cells(c.Row, 2).Value
                Workbooks(wb).Sheets(1).Cells(i, 7).Value = Workbooks(Diswb).Sheets(1).Cells(c.Row, 3).Value
                Workbooks(wb).Sheets(1).Cells(i, 11).Value = Workbooks(Diswb).Sheets(1).Cells(c.Row, 1).Value
                Workbooks(wb).Sheets(1).Cells(i, 12).Value = Workbooks(Diswb).Sheets(1).Cells(c.Row, 5).Value
                Workbooks(wb).Sheets(1).Cells(i, 13).Value = Workbooks(Diswb).Sheets(1).Cells(c.Row, 9).Value
                Workbooks(wb).Sheets(1).Cells(i, 14).Value = Workbooks(Diswb).Sheets(1).Cells(c.Row, 2).Value
                Workbooks(wb).Sheets(1).Cells(i, 15).Value = Workbooks(Diswb).Sheets(1).Cells(c.Row, 4).Value
            End If 'No else, loop until empty is found
             'Need to insert code here that of no empty was found, saveas samename_1, delete current, create samename_2, etc...
             'This isnt that important at the time because its very rare situation, mainly want current code to work
        Next
        Workbooks(wb).Close False
    Next
     
End Sub
 
Function IsWorkbookOpen(stName As String) As Boolean 'Checks for workbook being opened
    Dim Wkb As Workbook
    On Error Resume Next ' in case it isn't open
    Set Wkb = Workbooks(stName) 'Sets Wkb to Workbook sent through function call
    If Not Wkb Is Nothing Then IsWorkbookOpen = True 'True is workbook is open
End Function

does this do what you wanted?

NOTE: before running I suggest you change your loop else you will be looping through 65536 cells (G:G) - might be worth putting a check in there at some point... ie

for each c in range("G:G")
if c.value = "" then exit sub
'rest of code
next

or something to that effect.

Re: Error in code, not sure where?

agreed - there are a no. of errors with this that need fixing

are you trying to save the active workbooks as discrete_date.xls etc or create an entirely new workbook and then save it?

Re: Error in code, not sure where?

change wb and diswb to string type.

Re: Daily updated information placed in cells by month

nope - can't be > 50 KBs .. ie must be small .. dumbed down version required perhaps?

Re: Error in code, not sure where?

which line is causing the debug?

Re: Conditional sum total formula

why note

H = (B*C) + (D*E) + (F*G)

if C, E or G = 0 then sum of that section will also = 0

Re: Business Days - holidays and weekends

my fault...

make the bit exceptions absolute

so formula

=NETWORKDAYS(G5,H5,EXCEPTIONS!$B$1:$B$11)-1

where column G = statement date and H = metre date

using the pivot also means you can get rid of the sumproduct formulae I illustrated before.

however, that said - if you want to merge all the data together in the one pivot then we will need to go through that also... but one thing at a time.

Re: Business Days - holidays and weekends

ok see sheet exemptions