Byers2142 fucked around with this message at 02:10 on Mar 4, 2016

khazar sansculotte fucked around with this message at 21:43 on Mar 11, 2016

Sub GetData()
    Dim wkb As Workbook
    Dim wks As Worksheet
    Dim wksIndex As Worksheet
    Dim RowCount As Long

    RowCount = 4
    Set wkb = ActiveWorkbook
    Set wksIndex = wkb.Sheets("Index")

    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual

    ClearData
    SetDate

    'take H4:M7 from each sheet and put it on the index sheet
    For Each wks In wkb.Sheets
        If wks.Name <> "Index" And wks.Name <> "LastSheetName" Then 'change LastSheetName to its actual name
            wksIndex.Range(Cells(RowCount, 2), Cells(RowCount + 3, 7)).Value2 = wks.Range("H4:M7").Value2
            RowCount = RowCount + 6
        End If
    Next wks

    wksIndex.Cells(RowCount, 4) = "Total:"
    wksIndex.Cells(RowCount, 5) = Application.Sum(Range(Cells(1, 5), Cells(RowCount, 5)))

    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic

End Sub

schmagekie fucked around with this message at 19:28 on Mar 15, 2016

Ragingsheep fucked around with this message at 10:35 on Mar 21, 2016

Boris Galerkin fucked around with this message at 13:12 on Mar 22, 2016

Sub CheckForUserName()


    'If user name is not in the registry, Get from outlook and save it
    If GetSetting("BDA", "UserData", "UserName") = Empty Then
        Application.StatusBar = "Storing Outlook user name..."
        SaveSetting "BDA", "UserData", "UserName", GetOutlookName
        Application.StatusBar = False
    End If


End Sub


Private Function GetOutlookName(Optional First_or_Last As String) As String
    
'Returns the Outlook "Current User" name as a string
'Returns full name by defualt, but user can specify "First" or "Last"
    
Dim strName As String
Dim intPara1 As Integer
Dim intPara2 As Integer
Dim intComma As Integer
    
Dim OutApp As Object
Dim OutNS As Object
    
    Set OutApp = CreateObject("Outlook.Application")
    Set OutNS = OutApp.GetNameSpace("MAPI")
    
    Let strName = OutNS.CurrentUser
    
    Set OutApp = Nothing
    Set OutNS = Nothing
    
    'Remove any Parantheticals
    Let strName = Trim(strName)
    Let intPara1 = InStr(1, strName, "(", vbTextCompare)
    If Not intPara1 = 0 Then
        Let intPara2 = InStr(1, strName, ")", vbTextCompare)
        strName = Trim(Replace(strName, Mid(strName, intPara1, intPara2 - intPara1 + 1), "", , , vbTextCompare))
    End If
    
    'if First or Last is not specified, return the whole name
    If First_or_Last = Empty Then
        GetOutlookName = strName
        Exit Function
    End If
    
    'Find comma position to split names
    Let intComma = InStr(1, strName, ",", vbTextCompare)
    
    Select Case LCase(Left(First_or_Last, 1))
        
        Case "f"
            GetOutlookName = Right(strName, Len(strName) - intComma - 1)
        
        Case "l"
            GetOutlookName = Left(strName, intComma - 1)
    
        Case Else
            GetOutlookName = strName
    
    End Select

End Function

Squashy Nipples fucked around with this message at 02:19 on Apr 6, 2016