Using daily assistance registers to know if personal is currently on the office

I would like to make a column in which a color/icon indicates that the person is currently on the office or he/she is out due to multiple reasons. I have the following columns in a excel sheet to register the absences:

Employee name – Initial date(of absence) – end date(of absence) – Type of absence – Days

Example: John – 2/16/2018 – 2/16/2018 – sickness- 1

What I would like to know is that if there’s a way to use =TODAY() formula and compare it with the list and put in a column a certain color/sign depending if the person is currently absent. For example, having a column right beside the persons name that is named status and has this characteristic.

Maybe this is not possible in excel, or I should change the method of entering data. I’m open to opinions on ways to improve this system and answering doubts about the problem.

Thanks.

Populating recipient name in Outlook email

I created a vb macro to send emails to listed people in an excel file with their corresponding data table.

Everything is working fine just one problem! After many efforts I could not get/ write a code to get Name of the recipient after Hello in strbody.

Here is the sample file Click here

Link to RangetoHTML function Click here (it needs to be pasted after end sub in below code)

Below is has been fixed and working now. refer to the sample filefor column arrangement

Sub Credit_Auto()


 Dim test1 As Long, test2 As Long
 test1 = Timer
 Application.ScreenUpdating = False

'This code populates emails to outlook as per the Credit analysts.

    Dim OutApp As Object
    Dim OutMail As Object
    Dim rng As Range
    Dim Ash As Worksheet
    Dim Cws As Worksheet
    Dim Rcount As Long
    Dim Rnum As Long
    Dim FilterRange As Range
    Dim FieldNum As Integer
    Dim SigString As String
    Dim Signature As String
    Dim name_rg As Range
    Dim name As String


    Set OutApp = CreateObject("Outlook.Application")

 'You may want to change the signature file path below to get your signature properly

 'C:\Users\<UserName>\AppData\Roaming\Microsoft\Signatures
    SigString = Environ("appdata") & _
                "\Microsoft\Signatures\Pratik Kumar2.htm"


    If Dir(SigString) <> "" Then
    Signature = GetBoiler(SigString)
    Else
        Signature = ""
    End If

    On Error Resume Next

    With Application
        .EnableEvents = False
        .ScreenUpdating = False
    End With

    'Set filter sheet, you can also use Sheets("MySheet")
    Set Ash = ActiveSheet

    'Set filter range and filter column (column with e-mail addresses)
    Set FilterRange = Ash.Range("A1:G" & Ash.Rows.Count)
    FieldNum = 7   

    'Add a worksheet for the unique list and copy the unique list in A1

    Set Cws = Worksheets.Add
    FilterRange.Columns(FieldNum).AdvancedFilter _
            Action:=xlFilterCopy, _
            CopyToRange:=Cws.Range("A1"), _
            CriteriaRange:="", Unique:=True

    'Count of the unique values + the header cell
    Rcount = Application.WorksheetFunction.CountA(Cws.Columns(1))

    'If there are unique values start the loop
    If Rcount >= 2 Then
        For Rnum = 2 To Rcount

            'Filter the FilterRange on the FieldNum column
            FilterRange.AutoFilter Field:=FieldNum, _
                                   Criteria1:=Cws.Cells(Rnum, 1).Value

            'If the unique value is a mail address create a mail
            If Cws.Cells(Rnum, 1).Value Like "?*@?*.?*" Then

                With Ash.AutoFilter.Range
                    On Error Resume Next
                    Set rng = .SpecialCells(xlCellTypeVisible)
                    On Error GoTo 0
                End With

                Set OutMail = OutApp.CreateItem(0)

    'Search email address from Cws into Ash ~
    Set name_rg = Ash.Columns(7).Find(Cws.Cells(Rnum, 1))

    If Not name_rg Is Nothing Then
     'input the row index of <name_rg>
     'returns the name from col 6 ~
      name = Ash.Cells(name_rg.Row, 6)
    Else
     name = "email not found in Ash"
    End If


    Set name_rg = Nothing

    strbody = "Hello " & name & "," & "<br>" & "<br>" & _
              "Please allocate the below account(s) to it's appropriate parent account." & "<br>"


    On Error GoTo Cleanup


                On Error Resume Next

                With OutMail
                    .to = Cws.Cells(Rnum, 1).Value
                    .Subject = "Unallocated Credit Account"
                    .HTMLBody = strbody & RangetoHTML(rng) & "<br>" & Signature
                    .Send
                End With


                Set Ws = Nothing

                On Error GoTo 0

                Set OutMail = Nothing
            End If

            'Close AutoFilter
            Ash.AutoFilterMode = False

        Next Rnum
    End If


Cleanup:
    Set OutApp = Nothing
    Application.DisplayAlerts = False
    Cws.Delete
    Application.DisplayAlerts = True

    With Application
        .EnableEvents = True
        .ScreenUpdating = True
    End With

    test2 = Timer
    MsgBox "All the Credit Analysts have been notified and the entire process took " & Format((test2 - test1) / 86400, "hh:mm:ss") & " Seconds."

End Sub
Function RangetoHTML(rng As Range)
' Changed by Ron de Bruin 28-Oct-2006
' Working in Office 2000-2010
    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
Columns("E:G").Select
Selection.Delete Shift:=xlToLeft
        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

Function GetBoiler(ByVal sFile As String) As String
    Dim fso As Object
    Dim ts As Object
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set ts = fso.GetFile(sFile).OpenAsTextStream(1, -2)
    GetBoiler = ts.readall
    ts.Close
End Function

Update original data from pivot table? [on hold]

Objective: To update a column in the original data set from a pivot table

The Question: There is a requirement to update the original data set from a pivot table that is based on the same original data set.

How can I achieve this?

Further explanation:

The way that I think it should happen

How do I get values added in the RYG column of the pivot table to reflect in the Original data set? The RYG column in the original data set is empty

Changing font color in cell on double-click

In Excel (using VBA) I want to change the color of the check marks from gray to green on double-click, then back to gray again on double-click (basically a toggle). Current code is below – NOTHING I have tried has worked. Please help.

Here is the image. The font is Wingdings, character code is 252, font colors are #BEBEBE and #008000. I want those gray check marks to change to green on double click and if double clicked again, back to gray. This is in a range of cells (B7 to C150).

screenshot

CODE:

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

If Target.Column = 2 Then
Cancel = True
End If

If Target.Column = 3 Then
Cancel = True
End If

With Target.Font.Color
    If Not .Font.Color = vb15 Then
        .ColorIndex = vb10
    ElseIf Not .Font.Color = vb10 Then
        .ColorIndex = vb15
    End If
End With

End Sub

Thanks for any help!!

Cubevalue external data (SSAS) Error in SharePoint (Excel Online)

We have lots of reports written by our Business Analytics team that uses CUBEVALUES against an external data source (SSAS – Tabular Models or cubes).

We use cube values to allow for lots of flexibility in the reporting layout where a pivot table just doesn’t give us what we or the business is looking for.

If these reports are opened in Excel, no issues.

However, these reports do not play nice when we try to publish to OneDrive for users to open in Excel online (office.com)

Upon opening the file the user is prompted with warning Warning Dialog Box

User can click YES and then gets this next error Error Dialog Box

If there report was 100% pivot tables no warning/error, of it the report was 100% local (PowerPivot model) it also would produce no warning or errors if when cubevalues are used.

If it difficult for me to think about … (a) re-writing all our reports that don’t use cubevalues or (b) having to pull in all external data into a PowerPivot data model if we want to cube values.

We know the reports cannot be refreshed (if using external data sources) if opened via Excel online… but we aren’t worried about that, we just want the user to be able to open the report without the errors.

Adding a column to pivot table which averages sum of the count of each month per year

I am attempting to add another column to my pivot table in which it averages the sum of the count for the months within a year and then highlights the months that have a higher count than the average.

I know that there is a way to average in the pivot table, but not in the way that I am looking, as the average that I am looking for is dependent upon the sum of count.

I have not found anyway to do this in my own, and I am not sure if there is a way to do this, without it being overly complicated.

PIVOT TABLE

enter image description here

CODE

Private Sub pivot()

    Dim sht             As Worksheet
    Dim pvtCache        As PivotCache
    Dim pvt             As PivotTable
    Dim StartPvt        As String
    Dim rep             As Worksheet
    Dim SrcData         As String
    Dim lstrw           As Double

    Set rep = ThisWorkbook.Worksheets("Report")

    Dim xWs As Worksheet
    Dim sheetName As String
    Application.DisplayAlerts = False
    Err.Clear
    On Error Resume Next
    Set xWs = Sheets("Pivot")
    If Err <> 0 Then
        'Do Nothing
    Else
        xWs.Delete
    End If
    Application.DisplayAlerts = True

    Set sht = Sheets.Add(, rep)
    sht.Name = "Pivot"

    SrcData = rep.ListObjects("Date_Count")
    StartPvt = sht.Name & "!" & sht.Range("A3").Address(ReferenceStyle:=xlR1C1)

    Set pvtCache = ThisWorkbook.PivotCaches.Create( _
        SourceType:=xlDatabase, SourceData:=SrcData)

    Set pvt = pvtCache.CreatePivotTable( _
        TableDestination:=StartPvt, TableName:="Date_Count Pivot")

    With sht.PivotTables("Date_Count Pivot").PivotFields("Dates")
        .Orientation = xlRowField
        .Position = 1
    End With

    sht.PivotTables("Date_Count Pivot").AddDataField ActiveSheet.PivotTables( _
        "Date_Count Pivot").PivotFields("Count"), "Sum of Count", xlSum

    sht.Range("A4").Group Start:=True, End:=True, Periods:=Array(False, False, False, _
        False, True, False, True)

    lstrw = sht.Range("A1", sht.Range("A1").End(xlDown)).Rows.Count

End Sub

c# Search excel sheet and verify if textbox contents match cell

Newbie here looking for help please.

I have this code which works but it only confirms if the textbox text is found.

I have been trying to adapt it to confirm if textbox text matches the excel cell exactly or not when searching the excel sheet.
Please help as I am new to this and am getting a bit lost.

    private void button1_Click(object sender, EventArgs e)
    {
        Excel.Application xlApp = new Excel.Application();
        Excel.Workbook xlWorkBook = xlApp.Workbooks.Open(@"C:\pricefile.xlsx");
        Excel.Worksheet xlWorkSheet = xlWorkBook.Worksheets["Sheet1"];
        Excel.Range colRange = xlWorkSheet.Columns["A:A"];
        string searchString = textBox1.Text;
        Excel.Range resultRange = colRange.Find(
            What: searchString,
            LookIn: Excel.XlFindLookIn.xlValues,
            LookAt: Excel.XlLookAt.xlPart,
            SearchOrder: Excel.XlSearchOrder.xlByRows,
            SearchDirection: Excel.XlSearchDirection.xlNext
            );

        if (resultRange is null)
        {
            MessageBox.Show("Did not find " + searchString + " in Price File");
        }
        else
        {
            MessageBox.Show("Found " + searchString + " in Price File");
        }
        xlWorkBook.Close(false);
        xlApp.Quit();
    }

Any help would be wonderful.
Thank you.

SQL SERVER – reading excel files content and transfer to sql database using xp_cmdshell

I was shocked when I learned that importing the excel data to sql database using OPENROWSET has downsides as it truncates the cells’ values of it to 255-length-characters before it passes to the database. I’m now thinking of using xp_cmdshell to read the excel file’s data and transfer it to database. however I’m clueless on how I could do that. could somebody help me to achieve that?

.net: XLS->ODBC->DataTable – why doesn’t it just work?

I have build a small sample to test XLS-imports and am having problems.

Sample Data

If you trust me, the download is here
A really simple sheet, it looks like this:enter image description here

  • Column B is a manually entered date
  • Column C is a formula to calculate the age: =YEARFRAC(B2;TODAY())
  • Column F: =10*roundup(C2/10;0)

that should be enough for a repro

So, in any .net-language of your choice (I’m using APL but will spare you the details):

  • use the libraries ‘System.Data.Odbc,System.Data.dll’ ‘System.Data,system.data.dll’
  • initialize dtas a new DataTable-object
  • assign das new OdbcDataAdapter( 'SELECT * FROM [Tabelle1$]' 'Driver={Microsoft Excel Driver (*.xls, *.xlsx, *.xlsm, *.xlsb)};DBQ={Filename.xlsx};')
  • and finally do d.Fill(dt)
  • then look at the first record.

Here’s what I did and got:

     dt.Rows[0].ItemArray

???????????????????????????????????????????????????????????????????????????????????????????????????????    
?Michael?13.03.1966 00:00:00?Die Eingabezeichenfolge hat das falsche Format.?0?0?0?13.03.1966 00:00:00?    
???????????????????????????????????????????????????????????????????????????????????????????????????????

You see the 3d cell has an error-message instead of the age-calculation, the 5th cell is 0 instead of 60 and even worse: the calculation in G is not done – w/o any indication of there being a problem! Now, on one occasion I happened to have the sheet open in Excel while I went through this steps – and then I got correct results:

???????????????????????????????????????????????????????????????
?Michael?13.03.1966 00:00:00?51.925?0?0?60?13.03.2026 00:00:00?
???????????????????????????????????????????????????????????????

So, it is possible to have this working right!

A coworker tried to open the sheet on his machine and had to confirm a message about macros – and he claims it then worked right.

Well, is there a way to get this working w/o requiring people to open the sheet in Excel or fiddle with any of their settings?