Posts by Craig Ottley

Craig Ottley · May 18th 2011

Re: How to display Column names in Excel sheet when I retrieve data from MySQL

This should do the trick!

Code

Dim intFieldIndex As Integer


Worksheets("Sheet2").ClearContents


' Dump field names to the worksheet
For intFieldIndex = 0 To rs.Fields.Count - 1
    Worksheets("Sheet2").Cells(1, intFieldIndex + 1).Value = rs.Fields(intFieldIndex).Name
Next intFieldIndex


' Dump the records to the worksheet
Worksheets("Sheet2").Cells(2, 1).CopyFromRecordset rs

Display More

Craig Ottley · May 17th 2011

Re: LOOKUP with MATCH INDEX summing named range with multiple metrics

Can you take a sample collection from the workbook? I don't need the whole thing, only where you're currently at the final result... The bits in between we'll figure out together.

Craig Ottley · May 17th 2011

Re: Syntax error in DoCmd.RunSQL Access command

Hi Shenlung,

I think your syntax error is next to your where clause. You seem to have an extra apostrophe after the comma???

Try this...

Code

If Me.txtLocation = "IN" And Me.txtRecordType = "M" Then
      DoCmd.RunSQL "UPDATE MedicalRecords SET MedStatus='IN',MedOut='',MedDue='',Memo='" & Me.MemoField & "', WHERE Ssno='" & Me.txtSSno & "'"
    ElseIf Me.txtLocation = "IN" And Me.txtRecordType = "D" Then
      DoCmd.RunSQL "UPDATE MedicalRecords SET DenStatus='IN',DenOut='',DenDue='',Memo='" & Me.MemoField & "', WHERE Ssno='" & Me.txtSSno & "'"
    ElseIf Me.txtLocation = "OUT" And Me.txtRecordType = "M" Then
      DoCmd.RunSQL "UPDATE MedicalRecords SET MedStatus='OUT',MedOut=#" & Now() & "#,MedDue=#" & DateAdd("d", 14, Now()) & "#,Memo='" & Me.MemoField & "', WHERE Ssno='" & Me.txtSSno & "'"
    ElseIf Me.txtLocation = "OUT" And Me.txtRecordType = "D" Then
      DoCmd.RunSQL "UPDATE MedicalRecords SET DenStatus='OUT',DenOut=#" & Now() & "#,DenDue=#" & DateAdd("d", 14, Now()) & "#,Memo='" & Me.MemoField & "', WHERE Ssno='" & Me.txtSSno & "'"
    ElseIf Me.txtLocation <> "IN" And Me.txtLocation <> "OUT" And Me.txtRecordType = "M" Then
      DoCmd.RunSQL "UPDATE MedicalRecords SET MedStatus='" & Me.txtLocation & "',MedOut=#" & Now() & "#,MedDue=#" & DateAdd("d", 14, Now()) & "#,Memo='" & Me.MemoField & "', WHERE Ssno='" & Me.txtSSno & "'"
    ElseIf Me.txtLocation <> "IN" And Me.txtLocation <> "OUT" And Me.txtRecordType = "D" Then
      DoCmd.RunSQL "UPDATE MedicalRecords SET DenStatus='" & Me.txtLocation & "',DenOut=#" & Now() & "#,DenDue=#" & DateAdd("d", 14, Now()) & "#,Memo='" & Me.MemoField & "', WHERE Ssno='" & Me.txtSSno & "'"
    End If

Display More

Craig Ottley · May 17th 2011

Re: If cell equals search value/text string copy entire row to new worksheet

Hi Skillpede,

Have you got a sample workbook of what your data looks like now and where you'd want it transferred to?

Craig Ottley · May 16th 2011

Re: Formulas into custom vba functions

The above code relates to the very last bit... Are you able to piece the last bits together yourself now?

Craig Ottley · May 16th 2011

Re: Formulas into custom vba functions

Will an IF statement solve your problem??

IE

Code

If CDbl(Dir1.Value) = 0 And CDbl(Dir2.Value) = 0 And CDbl(Spd1.Value) = 0 And CDbl(Spd2.Value) = 0 Then
        udfGetGFSMOS = 0
Else
    udfGetGFSMOS = WDR
End If

Craig Ottley · May 16th 2011

Re: Formulas into custom vba functions

OK let's tackle one step at a time...

This requires a reference to be set in VBA. Make sure the Analysis Tool pack is selected in the Add-Ins, then in VBA select Tools--> References and then tick atpvbaen.xls

Try the following code to see if it yields the expected result with known values.

Code

Option Explicit


Public Function udfGetGFSMOS(ByVal Dir1 As Range, ByVal Dir2 As Range, _
                             ByVal Spd1 As Range, ByVal Spd2 As Range) As Double
                             
Dim Sin1 As Double, Sin2 As Double
Dim Cos1 As Double, Cos2 As Double
Dim SumOfSines As Double, SumOfCosines As Double
Dim AvgOfSines As Double, AvgOfCosines As Double
Dim RadiansDir1 As Double, RadiansDir2 As Double
Dim RWD As Double, WD As Double


Application.Volatile


    If Not IsNumeric(Dir1.Value) Or Not IsNumeric(Dir2.Value) _
        Or Not IsNumeric(Spd1.Value) Or Not IsNumeric(Spd2.Value) Then
        udfGetGFSMOS = CVErr(xlErrNum)
    End If
    
    RadiansDir1 = CDbl(Dir1.Value & "0")
    RadiansDir2 = CDbl(Dir2.Value & "0")
    
    Sin1 = CDbl(Spd1.Value) * (Math.Sin(WorksheetFunction.Radians(RadiansDir1)))
    Sin2 = CDbl(Spd2.Value) * (Math.Sin(WorksheetFunction.Radians(RadiansDir2)))
    Cos1 = CDbl(Spd1.Value) * (Math.Cos(WorksheetFunction.Radians(RadiansDir1)))
    Cos2 = CDbl(Spd2.Value) * (Math.Cos(WorksheetFunction.Radians(RadiansDir2)))
    
    SumOfSines = Sin1 + Sin2
    SumOfCosines = Cos1 + Cos2
    
    AvgOfSines = (Sin1 + Sin2) / 2
    AvgOfCosines = (Cos1 + Cos2) / 2
    
    
    RWD = WorksheetFunction.Atan2(AvgOfSines, AvgOfCosines)
    If RWD <= 0 Then
        RWD = RWD + 360
    End If
    
    WD = MRound(WorksheetFunction.Degrees(RWD), 10)
        
    udfGetGFSMOS = WD
    
Exit_Here:
    Exit Function


End Function

Display More

Craig Ottley · May 16th 2011

Re: Cut and designate paste clone values after the last entry in the column

Hi Brand_New2VBA,

Your inbox is full so i can't reply to your message...

Craig Ottley · May 16th 2011

Re: Formulas into custom vba functions

Hi wxchic,

This could probably do with some cleaning up but it seems to do the job...

Code

Option Explicit


Public Function udfGetGFSMOS(ByVal Dir1 As Range, ByVal Dir2 As Range, _
                             ByVal Spd1 As Range, ByVal Spd2 As Range) As Double
                             
Dim Sin1 As Double, Sin2 As Double
Dim Cos1 As Double, Cos2 As Double
Dim SumOfSines As Double, SumOfCosines As Double
Dim AvgOfSines As Double, AvgOfCosines As Double
Dim RadiansDir1 As Double, RadiansDir2 As Double
Dim RWD As Double, WD As Double


Application.Volatile


    If Not IsNumeric(Dir1.Value) Or Not IsNumeric(Dir2.Value) _
        Or Not IsNumeric(Spd1.Value) Or Not IsNumeric(Spd2.Value) Then
        udfGetGFSMOS = CVErr(xlErrNum)
    End If
    
    RadiansDir1 = CDbl(Dir1.Value & "0")
    RadiansDir2 = CDbl(Dir2.Value & "0")
    
    Sin1 = CDbl(Spd1.Value) * (Math.Sin(WorksheetFunction.Radians(RadiansDir1)))
    Sin2 = CDbl(Spd2.Value) * (Math.Sin(WorksheetFunction.Radians(RadiansDir2)))
    Cos1 = CDbl(Spd1.Value) * (Math.Cos(WorksheetFunction.Radians(RadiansDir1)))
    Cos2 = CDbl(Spd2.Value) * (Math.Cos(WorksheetFunction.Radians(RadiansDir2)))
    
    SumOfSines = Sin1 + Sin2
    SumOfCosines = Cos1 + Cos2
    
    AvgOfSines = (Sin1 + Sin2) / 2
    AvgOfCosines = (Cos1 + Cos2) / 2
    
    RWD = WorksheetFunction.Atan2(AvgOfSines, AvgOfCosines)
    WD = WorksheetFunction.Round(WorksheetFunction.Degrees(RWD), 10)
    
    udfGetGFSMOS = WD
    
Exit_Here:
    Exit Function


End Function

Display More

HTH

Craig Ottley · May 16th 2011

Re: Formulas into custom vba functions

Can you post a sample workbook please? I'll take a look at it later on for you... How are you planning on deploying the function? Via an Add-in or something else?

Craig Ottley · May 16th 2011

Re: Formulas into custom vba functions

Hi wxchic,

If you've already got this working as a formula, you won't gain any performance using VBA...

What exactly do you want returning? A function for WD and a function for RWD? or just a singular number?

Craig Ottley · May 16th 2011

Re: date and % with IF function

If you look in my example in column E Row 5 = nothing, 6 = OVERDUE, 7 = ON SCHEDULE 8 = ON SCHEDULE...

Craig Ottley · May 16th 2011

Re: VBA code to refresh different sheets based on the days date

If you've got access to Visual Studio you create an executable that creates an Excel Workbook. You can call the db procedures that populates the workbook and then setup a scheduled task...

I wouldn't recommend creating a scheduled task for excel as it imposes a security risk as you'd need to trust macro's without prompting.

What options do you have available?

Craig Ottley · May 16th 2011

Re: Automatically find and update a row based on user inputs

Hi James,

Is there any particular reason why the user needs to use a CRUD approach? Seems like a lot of additional work when you've already got a source list....

Craig Ottley · May 16th 2011

Re: VBA code to refresh different sheets based on the days date

Where does the data get populated from? IE Database, Other workbooks etc...

Craig Ottley · May 16th 2011

Re: date and % with IF function

The attached seems to work for me...
forum.ozgrid.com/index.php?attachment/38317/

Craig Ottley · May 16th 2011

Re: How do I Copy an Entire Excel Sheet into an Access Table

Hi Robco32,

Have you managed to find any example of opening a connection to Access first and then loading any data into a table in Access?

Craig Ottley · May 16th 2011

Re: Control MS Excel from Access VBA

Hi Janie,

You normally have to get control of the Excel.Application object and then from there you can control excel as you please...

HTH

Craig

Craig Ottley · May 16th 2011

Re: vba goto specific cell excel

Hi!

Welcome to Ozgrid. If you want to write data to a specific cell you can use a one line piece of code...

Example

Code

Sub writeValueToCell()


Sheet1.Range("A1903").Value = "Summary"


End Sub

If you need more examples there are thousands available on this site.

HTH

Craig Ottley · May 16th 2011

Re: LOOKUP with MATCH INDEX summing named range with multiple metrics

Hi Lee,

Do you have a sample workbook? This would help a great deal when dealing with a matrix...

Thanks

Craig