Date Data Tracking

**Pancakes1032** · 11-13-2014, 01:20 PM

I need a little help with this code. I'm trying to be able to track the data of certain cells and columns. I got this to work on another workbook for different columns though and somehow cannot seem to get this to work for this one. It is counting all the data correctly, but it's not doing it by dates or even the correct months. Here is my code below:

Sub date_D()
Dim sdate As Long
Dim edate As Long
Dim thestring As String

    thestring = Sheets("Master log").Cells(4, "T").Value
    If IsDate(thestring) Then
        sdate = DateValue(thestring)
    Else
        MsgBox "Invalid FROM date"
        Exit Sub
    End If
    thestring = Sheets("Master log").Cells(4, "V").Value
    If IsDate(thestring) Then
        edate = DateValue(thestring)
    Else
        MsgBox "Invalid TO date"
        Exit Sub
    End If
    'MsgBox sdate & "," & edate
    If edate < sdate Then
        MsgBox "TO date prior to FROM date. Please re-enter dates and rerun the program."
    Else
        Call main(sdate, edate)
    End If
    Sheets("Master log").Select
End Sub

Sub date_K()
Dim sdate As Long
Dim edate As Long
Dim thestring As String
Dim mon As String
Dim m As Integer
Dim ye As Integer

    mon = Sheets("Master log").Cells(7, "T").Value
    ye = Sheets("Master log").Cells(7, "U").Value
    sdate = DateValue("01 " & mon & " " & ye)
    edate = DateSerial(Year(DateValue("01 " & mon & " " & ye)), Month(DateValue("01 " & mon & " " & ye)) + 1, 0)
    Call main(sdate, edate)
    Sheets("Master log").Select
End Sub

Function main(sdate As Long, edate As Long)
Dim st As Long
Dim ed As Long
Dim temp As Long
Dim un_cf As String
Dim unc As Long
Dim un_cw As String
Dim uncw As Long
Dim un_r As String
Dim unr As Long
Dim pr_c As String
Dim prc As Long
Dim pr_cw As String
Dim prcw As Long
Dim pr_r As String
Dim prr As Long
Dim in_c As String
Dim inc As Long
Dim v_un As String
Dim v_pr As String
Dim vun As Long
Dim vpr As Long
Dim c_w As String
Dim cw As Long
Dim c_f As String
Dim cf As Long
Dim r_es As String
Dim res As Long
Dim v_er As String
Dim ver As Long
Dim I, j, l, k As Long
Dim WS_Count As Integer
Dim c_count As Long
Dim listi As Long

    'define status
    un_cf = "Unprocessed CF"
    un_cw = "Unprocessed CW"
    un_r = "Unprocessed Restoration"
    pr_c = "Processed CF"
    pr_cw = "Processed CW"
    pr_r = "Processed Restoration"
    in_c = "Incomplete"
    v_un = "Verification Unprocessed"
    v_pr = "Verification Processed"
    c_w = "CW SAR7"
    c_f = "CF SAR7"
    r_es = "Restoration"
    v_er = "Verification"
    ' Set WS_Count equal to the number of worksheets in the active workbook.
    WS_Count = ActiveWorkbook.Worksheets.Count
    ' Begin the loop.
    listi = 2
    For I = 1 To WS_Count
        If InStr(ActiveWorkbook.Worksheets(I).Name, "Employee-") > 0 Then
            Worksheets(I).Select
            c_count = Application.WorksheetFunction.CountA(Worksheets(I).Range("A:A"))
            Range("A1:K" & c_count).Select
            Selection.AutoFilter
            Range("F9").Select
            ActiveWorkbook.Worksheets(I).AutoFilter.Sort.SortFields.Clear
            ActiveWorkbook.Worksheets(I).AutoFilter.Sort.SortFields.Add Key:= _
            Range("A1:A" & c_count), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption _
            :=xlSortNormal
            With ActiveWorkbook.Worksheets(I).AutoFilter.Sort
                .Header = xlYes
                .MatchCase = False
                .Orientation = xlTopToBottom
                .SortMethod = xlPinYin
                .Apply
            End With
            Selection.AutoFilter
            st = 0
            ed = 0
            l = 0
            k = 0
            j = 2
            Do While j <= c_count
                temp = Worksheets(I).Cells(j, "B").Value
                If sdate <= temp Then
                    st = j
                    Exit Do
                End If
                j = j + 1
            Loop
            j = c_count
            Do While j >= 2
                temp = Worksheets(I).Cells(j, "B").Value
                If edate >= temp Then
                    ed = j
                    Exit Do
                End If
                j = j - 1
            Loop
            If st = 0 And ed = c_count Then
                unc = 0
                uncw = 0
                unr = 0
                prc = 0
                prcw = 0
                prr = 0
                inc = 0
                vun = 0
                vpr = 0
                cw = 0
                cf = 0
                res = 0
                ver = 0
                 
            Else
              
                 unc = Application.WorksheetFunction.CountIf(Worksheets(I).Range("I" & st & ":I" & ed), un_cf)
                 uncw = Application.WorksheetFunction.CountIf(Worksheets(I).Range("I" & st & ":I" & ed), un_cw)
                 unr = Application.WorksheetFunction.CountIf(Worksheets(I).Range("I" & st & ":I" & ed), un_r)
                 prc = Application.WorksheetFunction.CountIf(Worksheets(I).Range("I" & st & ":I" & ed), pr_c)
                 prcw = Application.WorksheetFunction.CountIf(Worksheets(I).Range("I" & st & ":I" & ed), pr_cw)
                 prr = Application.WorksheetFunction.CountIf(Worksheets(I).Range("I" & st & ":I" & ed), pr_r)
                 inc = Application.WorksheetFunction.CountIf(Worksheets(I).Range("I" & st & ":I" & ed), in_c)
                 vun = Application.WorksheetFunction.CountIf(Worksheets(I).Range("I" & st & ":I" & ed), v_un)
                 vpr = Application.WorksheetFunction.CountIf(Worksheets(I).Range("I" & st & ":I" & ed), v_pr)
                 cw = Application.WorksheetFunction.CountIf(Worksheets(I).Range("C" & st & ":C" & ed), c_w)
                 cf = Application.WorksheetFunction.CountIf(Worksheets(I).Range("C" & st & ":C" & ed), c_f)
                 res = Application.WorksheetFunction.CountIf(Worksheets(I).Range("C" & st & ":C" & ed), r_es)
                 ver = Application.WorksheetFunction.CountIf(Worksheets(I).Range("C" & st & ":C" & ed), v_er)
            End If
            Sheets("Master log").Cells(listi, "A").Value = Worksheets(I).Name
            Sheets("Master log").Cells(listi, "B").Value = prc
            Sheets("Master log").Cells(listi, "C").Value = prcw
            Sheets("Master log").Cells(listi, "D").Value = prr
            Sheets("Master log").Cells(listi, "E").Value = unc
            Sheets("Master log").Cells(listi, "F").Value = uncw
            Sheets("Master log").Cells(listi, "G").Value = unr
            Sheets("Master log").Cells(listi, "H").Value = inc
            Sheets("Master log").Cells(listi, "I").Value = unc + uncw + unr
            Sheets("Master log").Cells(listi, "J").Value = prc + prcw + prr
            Sheets("Master log").Cells(listi, "K").Value = cw
            Sheets("Master log").Cells(listi, "L").Value = cf
            Sheets("Master log").Cells(listi, "M").Value = res
            Sheets("Master log").Cells(listi, "N").Value = cw + cf + res
            Sheets("Master log").Cells(listi, "O").Value = ver
            Sheets("Master log").Cells(listi, "P").Value = vpr
            Sheets("Master log").Cells(listi, "Q").Value = vun
            Sheets("Master log").Cells(listi, "R").Value = prc + prcw + prr + vpr
            
            listi = listi + 1
        End If
    Next I
         
    Sheets("Master log").Cells(listi, "A").Value = "Total"
    Sheets("Master log").Cells(listi, "B").Value = Application.WorksheetFunction.Sum(Sheets("Master log").Range("B2:B" & listi - 1))
    Sheets("Master log").Cells(listi, "C").Value = Application.WorksheetFunction.Sum(Sheets("Master log").Range("C2:C" & listi - 1))
    Sheets("Master log").Cells(listi, "D").Value = Application.WorksheetFunction.Sum(Sheets("Master log").Range("D2:D" & listi - 1))
    Sheets("Master log").Cells(listi, "E").Value = Application.WorksheetFunction.Sum(Sheets("Master log").Range("E2:E" & listi - 1))
    Sheets("Master log").Cells(listi, "F").Value = Application.WorksheetFunction.Sum(Sheets("Master log").Range("F2:F" & listi - 1))
    Sheets("Master log").Cells(listi, "G").Value = Application.WorksheetFunction.Sum(Sheets("Master log").Range("G2:G" & listi - 1))
    Sheets("Master log").Cells(listi, "H").Value = Application.WorksheetFunction.Sum(Sheets("Master log").Range("H2:H" & listi - 1))
    Sheets("Master log").Cells(listi, "I").Value = Application.WorksheetFunction.Sum(Sheets("Master log").Range("I2:I" & listi - 1))
    Sheets("Master log").Cells(listi, "J").Value = Application.WorksheetFunction.Sum(Sheets("Master log").Range("J2:J" & listi - 1))
    Sheets("Master log").Cells(listi, "K").Value = Application.WorksheetFunction.Sum(Sheets("Master log").Range("K2:K" & listi - 1))
    Sheets("Master log").Cells(listi, "L").Value = Application.WorksheetFunction.Sum(Sheets("Master log").Range("L2:L" & listi - 1))
    Sheets("Master log").Cells(listi, "M").Value = Application.WorksheetFunction.Sum(Sheets("Master log").Range("M2:M" & listi - 1))
    Sheets("Master log").Cells(listi, "N").Value = Application.WorksheetFunction.Sum(Sheets("Master log").Range("N2:N" & listi - 1))
    Sheets("Master log").Cells(listi, "O").Value = Application.WorksheetFunction.Sum(Sheets("Master log").Range("O2:O" & listi - 1))
    Sheets("Master log").Cells(listi, "P").Value = Application.WorksheetFunction.Sum(Sheets("Master log").Range("P2:P" & listi - 1))
    Sheets("Master log").Cells(listi, "Q").Value = Application.WorksheetFunction.Sum(Sheets("Master log").Range("Q2:Q" & listi - 1))
    Sheets("Master log").Cells(listi, "R").Value = Application.WorksheetFunction.Sum(Sheets("Master log").Range("R2:R" & listi - 1))

End Function

**MINCUS1308** · 11-14-2014, 11:59 AM

code is hard to read/understand. can you share the file?

orrrr i would suggest debugging by "stepping into" during execution.
set watches on your variables and identify whats happening.

**Pancakes1032** · 11-14-2014, 12:21 PM

I apologize for the confusion. I know that the error is here. It's not really giving me a specific line of error and I just haven't done the step into yet, but I know that this is specifically what isn't working because this is what is telling the workbook to count, but it's just counting collectively and not counting by the date ranges or by the month range like it should.

' Set WS_Count equal to the number of worksheets in the active workbook.
WS_Count = ActiveWorkbook.Worksheets.Count
' Begin the loop.
listi = 2
For I = 1 To WS_Count
If InStr(ActiveWorkbook.Worksheets(I).Name, "Employee-") > 0 Then
Worksheets(I).Select
c_count = Application.WorksheetFunction.CountA(Worksheets(I).Range("A:A"))
Range("A1:K" & c_count).Select
Selection.AutoFilter
Range("F9").Select
ActiveWorkbook.Worksheets(I).AutoFilter.Sort.SortFields.Clear
ActiveWorkbook.Worksheets(I).AutoFilter.Sort.SortFields.Add Key:= _
Range("A1:A" & c_count), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption _
:=xlSortNormal
With ActiveWorkbook.Worksheets(I).AutoFilter.Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Selection.AutoFilter
st = 0
ed = 0
l = 0
k = 0
j = 2
Do While j <= c_count
temp = Worksheets(I).Cells(j, "B").Value
If sdate <= temp Then
st = j
Exit Do
End If
j = j + 1
Loop
j = c_count
Do While j >= 2
temp = Worksheets(I).Cells(j, "B").Value
If edate >= temp Then
ed = j
Exit Do
End If
j = j - 1
Loop
If st = 0 And ed = c_count Then
unc = 0
uncw = 0
unr = 0
prc = 0
prcw = 0
prr = 0
inc = 0
vun = 0
vpr = 0
cw = 0
cf = 0
res = 0
ver = 0

Else

**Bob Phillips** · 11-14-2014, 12:41 PM

Why are you using VBA not formulae?

Still need to see the data.

**SamT** · 12-06-2014, 03:56 PM

Pancakes,

You didn't get that code from us, did you? I have Saved a copy of your Sar_Master Log file and am working on it.

I'll get back to you when I have something worthwhile.

Can you give me the link to our original thread? It has left the Radar while I have been on vacation.

**Pancakes1032** · 12-09-2014, 08:37 PM

Oh no I didn't get the code from you, I actually was able to fix the problem. I had to go through someone else because I didn't get a response from Jacob timely and I needed to have my project completed. I like the workbook I have now, but it's not as efficient as I would like them to be. I have buttons that contain the macro code to do what I need them to do but I don't like that I have to have the master workbook as a shared file because the code requires the opening and closing of the workbook to pull and send the data. I know that you were suggesting userforms and I know how to create them now, but are they able to communicate with another workbook better/easier then using a button that contains a macro? I'm eventually transitioning my entire project to Access databases and using excel to communicate with Access, but that'll take months to complete. I'm just trying to improve this one.

Here's the link to our last convo: http://www.vbaexpress.com/forum/show...rent-workbooks

**SamT** · 12-10-2014, 01:18 AM

Thanks Pancakes.

the original idea of mine about using UserForms is that it makes it much easier to transition to a database and It greatly facilitates transferring the User Experience.

CU L8er

snb · 12-10-2014, 03:31 AM

some steps:

Sub date_D()
    sn = Split(",Invalid FROM Date,Invalid TO Date,TO date prior to FROM date", ",")
    c01 = Sheets("Master log").Cells(4, 20)
    c02 = Sheets("Master log").Cells(4, 22)
    
    If IsDate(c01) * IsDate(c02) * c01 > c02 = 0 Then
       MsgBox Choose(Not IsDate(c01) + Not IsDate(c02) + 4 * (c01 < c01), sn(1), sn(2), sn(1), sn(3), sn(1), sn(2), sn(1)) & ". Please re-enter dates and rerun the program."
    Else
       main CDate(c01), CDate(c02)
    End If
End Sub

Sub date_K()
    c01 = DateSerial(Sheets("Master log").Cells(7, "T"), Sheets("Master log").Cells(7, "U"), 1)
    main c01, DateAdd("m", 1, c01) - 1
End Sub

**SamT** · 12-10-2014, 03:48 PM

Maria,

I have reviewed our previous convo and the workbook you posted in this one and the books do not match at all.

Do you prefer the old Play_Master and Play_Employee or the new Sar_MasterLog?

**Pancakes1032** · 12-11-2014, 07:57 AM

Master logcode.xlsm Employee-code.xlsmHi Sam, oh no they don't match at all. I kind of went a different way because I was limited in my skills but I'm going to up load the new workbooks I have when I get into the office. I've created 6 workbooks since our last convo. They're all pretty similar since I only know so much code. I'm still trying to improve them and I'm actually transitioning into creating an Access database.

**SamT** · 12-11-2014, 01:49 PM

Have you put much thought into the database structure?

Quite a bit of code there.

Did you know? LOL

Sub test()
    Application.EnableEvents = False 'Prevents all Event triggered code from running
      'No Sub XXX_Change will run now.
      'No Delete/Add Code subs needed here.

    Application.EnableEvents = True 'Allows event triggers
      'All Worksheet_Change subs will run now.
End Sub

See Application Object Properties, especially DisplayAlerts, EnableEvents, and ScreenUpdating. If you still have a copy of Excel XP laying around, keep it if only for the help files.

**Pancakes1032** · 12-11-2014, 02:37 PM

Thanks for the code! I am actually working towards transitioning into a database structure, I just have to slowly do it since I'm not 100% proficient in database systems and I have a ton of other work to complete.

Thread: Date Data Tracking

Thread Tools

Display

Date Data Tracking

Tags for this Thread

Posting Permissions