I have a macro that pulls info from several daily log sheets and compiles that info in a master workbook. In the same macro I manipulate the data so that it populates several charts and graphs. The problem that I have is the info would be most usefull if I could establish a date range that I wanted to look at and only pull that data. For exampl if I want to see the amount of scrap created by all machines from 9/9/14 to 11/9/14. Is there a way I could add this to the begining of my already created macro? The info I'm working with looks something like what I have below.
Machine Operator Date Production Scrap
A w 9/9/14 300 15
B x 9/9/14 400 0
C y 9/12/14 150 50
D z 10/9/14 200 3
This is tested. It will work with a table of changing lengths, and you can adapt the concepts in this to many needs. Have fun.
Sub ScrapCount()
Dim str_dateMin As String
Dim str_dateMax As String
Dim dateMin As Date
Dim dateMax As Date
Dim lastRow As Long
Dim subTotal As Double
Dim lookupDate As Date
Dim lRow As Long
lastRow = Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Row
subTotal = 0
str_dateMin = InputBox("Input beginning date, mm/dd/yyyy:")
str_dateMax = InputBox("Input end date, mm/dd/yyyy:")
dateMin = CDate(str_dateMin)
dateMax = CDate(str_dateMax)
For lRow = 2 To lastRow
lookupDate = Sheets("Sheet1").Cells(lRow, "C").Value
If dateMin <= lookupDate And lookupDate <= dateMax Then
subTotal = subTotal + Sheets("Sheet1").Cells(lRow, "E").Value
End If
Next lRow
MsgBox ("Total scrap for date range = " & subTotal)
End Sub
Very broad but here is what I would go with:
Beginning of macro calls a InputBox for date range (1 for start 1
for end) and stores as date variables)
Loop through rows and only
copy if value of date cell is within range of defined variables from
step 1
Related
Attaching image for better understanding of question:
Here, Column A has dates, B has daily amount and C has the cumulative sum of each days.
I want to stop the cumulative calculation at end of each month based on A column and start recalculating for next month. Just like shown in image.
I am using below code to find the end of month and on first day of month assigning B=C, But confused how can I start calculating cumulative amount from next day onward for that month.
Appreciate if someone provide me a logic to achieve this.
Sub MonthInt()
Dim MaxGain As Workbook
Dim DailyData As Worksheet
Dim n As Long, J As Long
Set MaxGain = Excel.Workbooks("MaxGain.xlsm")
Set DailyData = MaxGain.Worksheets("DailyData")
n = DailyData.Cells(Rows.Count, "A").End(xlUp).Row
DailyData.Range("B2") = DailyData.Range("C2")
For J = 3 To n
If DailyData.Range("A" & J) = Application.WorksheetFunction.EoMonth(DailyData.Range("A" & J), 0) Then
DailyData.Range("C" & J + 1) = DailyData.Range("B" & J)
End If
Next
End Sub
Why do you need VBA to get the desired output?
You may use the formulas to achieve the desired output.
Try this...
In C2
=B2
In C3
=IF(MONTH(A3)<>MONTH(A2),B3,C2+B3)
and copy it down.
Edit:
If you want to implement the formula through VBA, you may try something like this...
Sub MonthInt()
Dim MaxGain As Workbook
Dim DailyData As Worksheet
Dim n As Long
Set MaxGain = Excel.Workbooks("MaxGain.xlsm")
Set DailyData = MaxGain.Worksheets("DailyData")
n = DailyData.Cells(Rows.Count, "A").End(xlUp).Row
With DailyData
.Range("C2").Value = .Range("B2").Value
.Range("C3:C" & n).Formula = "=IF(MONTH(A3)<>MONTH(A2),B3,C2+B3)"
.Range("C3:C" & n).Value = .Range("C3:C" & n).Value
End With
End Sub
I have a vba-created speadsheet with 4 sets of criteria. I need to highlight names at the bottom of the sheet based on whether or not they meet all the criteria.
I need the name to highlight if the analyst took 91 minutes or less of total break (B3:F9) each day, 15 minutes or less of tea break (B12:F18), and made at least 3 outbound calls each day (provided the staff time was 8 hours and 58 minutes or more (if it wasn't, the 3 call threshold does not apply)).
So, a function would be something like:
If
TtlB<91 mins & TeaB<15
& If
StfT <8:58:00 ignore ObC
Else If
StfT >8:58:00 & ObC>=3
Highlight (analyst name in A22:A28)
I know it will probably involve a nested loop or two, I just don't know where to get started. The loop for calculating "Total Minutes Owed" is below which can probably be modified to help me get started with this.
Dim i As Integer, j As Integer, k As Integer
j = 3
k = 12
For i = 22 To 28
Range("B" & i) = "=SUM(G" & j & ",G" & k & ")"
j = j + 1
k = k + 1
Next i
I'm pretty shure that a much more compact code can be done. But, since nobody answer you in the last four hours, try the following at least as an start.
Private Sub CommandButton1_Click()
Dim oWs As Worksheet
Dim rAnalysts As Range
Dim rBreak As Range
Dim rObC As Range
Dim rTea As Range
Dim rST As Range
Dim rRow As Range
Dim rIntersection As Range
Dim rCell As Range
Set oWs = Worksheets("MyData") 'The worksheet where data resides
MaxBreakTime = oWs.Cells(1, 7).Value 'The max break time. I set it in cell G1. Change according to your needs
Set rAnalysts = oWs.Rows("3:9") 'Define the rows for analysts
Set rBreak = oWs.Range("B:F") 'define the columns where Break data is placed
'(similarly, set ranges for tea break, etc)
For Each rRow In rAnalysts.Rows 'for each row in the analyst range
sAnalystName = oWs.Cells(rRow.Row, 1).Value 'get the name of the analyst
lBreakTime = 0 'restart this variable to zero
Set rIntersection = Application.Intersect(rRow, rBreak) ' intersect the row (the analyst) with the columns of the Break range
If rIntersection Is Nothing Then
MsgBox "Ranges do not intersect. Something is radically wrong."
Else
For Each rCell In rIntersection.Cells 'id est, friday through thursday
If rCell.Value > MaxBreakTime Then 'if break was longer that stipulated,....
lBreakTime = lBreakTime + rCell.Value - MaxBreakTime 'add the excess to the variable
End If
Next
End If
'write data somewhere (here, 30 rows down from original Analysts range)
oWs.Cells(rRow.Row + 30, 1) = sAnalystName
oWs.Cells(rRow.Row + 30, 2) = lBreakTime
If lBreakTime > 0 Then
oWs.Cells(rRow.Row + 30, 2).Font.Color = vbGreen
oWs.Cells(rRow.Row + 30, 2).Interior.Color = vbRed
End If
Next
'Here something similar for Tea break and Outbounds calls
'Since output is already writen, you can reuse variables like rIntersection or rCell
End Sub
I am a brand new VBA user attempting to copy and paste data based on a range of dates. In column one I have dates and in column two I have the data I would like to copy and paste. CurYear refers to the end date in the range I am looking for and StatDate refers to the beginning date in the Range I am looking for. When I run this code it crashes Excel. Please help I am very lost
Worksheets("Weekly").Select
Dim nRows As Integer
Dim CurYear As Date
Dim StartDate As Date
nRows=Range("A1").CurrentRegions.Count.Rows
CurYear=Range("I265").Value
StartDate=Range("M5").Value
Do While Cells(nRows,1)<>""
if Cells(nRows,1).Value< CurYear & Cells(nRows,1)> StartDate Then
Cells(nRows,1).Offset(0,1).Copy
Worksheets("Weekly").Range("H41").Paste
Loop
End If
Put "option explicit" at the top of your code (before the sub) and it will tell you things to fix. Doing that will fix the part of your error where your end if was outside the loop instead of inside it but it won't catch that you weren't changing your loop counter. Try this code instead. It is actually pretty much the same as what you had with a couple minor changes.
Option Explicit
Sub test()
Dim sht As Worksheet, i As Long, l As Long, j
Dim nRows As Integer
Dim CurYear As Date
Dim StartDate As Date
Set sht = Worksheets("Test1") ' set the sheet as object isntead of selecting it for faster code and avoiding other issues
nRows = Cells(sht.Rows.Count, "B").End(xlUp).Row 'Last used row in column B - current region lastrow gets twitchy in some circumstances and should be avoided unless there is a reason to use it
l = 41
CurYear = range("I265").Value
StartDate = range("M5").Value
For i = 1 To nRows
If Cells(i, 1).Value < CurYear And Cells(i, 1).Value > StartDate Then 'for If statements you use "and" not "&"
Cells(l, 15) = Cells(i, 2) 'you will want something like this line and the next if you don't want to overwrite H41 if there is more than one match
l = l + 1
End If
Next i
End Sub
Also, to help with debugging, Open your locals window (View in the VBE). Step through your code with F8, watching your variables in the locals window to ensure that they are what you expect them to be at that step in your script.
If you do this with your code, you will see that you were missing a counter change with your variable for your loop. So it was looking for nRow to eventually be "" but it stays at whatever it was set to. Infinite loop. I changed it to a for next format but 6 of 1 and half dozen of another for your code.
Welcome to VBA. Don't poke yer eye out. :-)
Instead of using copy/ paste that uses a lot of memory and makes the program run slow, you maybe want to consider the following code that serves the same purpose as your code or Rodger's yet faster than using Select and copy/ paste syntax.
Sub Test()
Dim nRows As Long, LastRow As Long 'Declare as Long instead of Integer to avoid overflow
Dim CurYear As Date, StartDate As Date
LastRow = Cells(Rows.Count, 1).End(xlUp).Row 'Count the last used row in column 1 where you put the first data (dates)
nRows = 2 'Set the starting point of row where you put the first data (dates). In this example I use 2
CurYear = Range("I265").Value
StartDate = Range("M5").Value
Do
If Cells(nRows, 1).Value < CurYear And Cells(nRows, 1) > StartDate Then 'Use And not &
Cells(nRows, 5).Value = Cells(nRows, 2).Value 'This is essentially a "copy/ paste" syntax. Change the value (5) to the column you want to paste the value in column 2
End If
nRows = nRows + 1 'Set an increment value so each looping the nRows will increase by 1
Loop Until nRows = LastRow + 1 'Added by 1 so that the data in LastRow will keep being processed
End Sub
I am trying to set up a function which will be able to check dates from one sheet (sheet1) through 2 columns: startDate and endDate in Sheet2. And if there are matching then I want to copy values from one cell which is located on sheet2 into specific cell (the same row where is the cheking date) into sheet1.
I wrote some code, but later on I've realized that my logic is not good.
I also found this link on stackoverflow website...
my xls file - function is in the module 3 "checkDate"
and here is the code..I need find function somehow..maybe I need to insert two iterators (2 for loops?)
Sub CheckDate()
Dim d1 As Date
Dim d2 As Date
Dim datumPok As Date
Dim s As String
Dim i As Long
Dim LR As Long
LR = Range("K" & Rows.Count).End(xlUp).Row
For i = 2 To LR
d1 = ActiveWorkbook.Worksheets("Glasnik").Cells(i, 2).Value
d2 = ActiveWorkbook.Worksheets("Glasnik").Cells(i, 3).Value
With .Range("K" & i)
datumPok = ActiveWorkbook.Worksheets("Spisak").Cells(i, 11)
If d1 < datumPok < d2 Then
MsgBox "opaaa"
s = ActiveWorkbook.Worksheets("Glasnik").Cells(i, 4).Value
ActiveWorkbook.Worksheets("Spisak").Cells(i, 6).Value = s
Else
MsgBox "test"
End If
End With
Next i
End Sub
I am really into this..thanks guys!
I found the solution!
Ordinary lookup with some mathematic formula was enough.
=LOOKUP(2,1/((G1>=$A$1:$A$24)*(G1<=$B$1:$B$24)),$C$1:$C$24)
assuming that date is in the column G1..
Thanks to all! :)
I am calculating the number of work hours (8am to 8pm) between the 2 given dates, excluding Weekends and Public holidays, but my code syntax is incorrect.
Sample data:
Start day: 17/06/2011 08:00:00 AM
End day: 19/06/2011 08:00:00 PM
Sub SLA_Days_Resolved_F()
Dim x As Integer
' Set numrows = number of rows of data.
NumRows = Range("F2", Range("F2").End(xlDown)).Rows.Count
Dim total As Integer 'to count the total hours
Dim st As String 'start date cell
Dim en As String 'end date cell
Dim destCell As String
Dim d As Date ' for the loop
total = 0
' Establish "For" loop to loop "numrows" number of times.
For x = 2 To NumRows + 1
st = "G" & CStr(x) 'reference to the cells
en = "D" & CStr(x)
'loop from start date to end date
For d = Date(Range(st)) To Date(Range(en))
'check if the current date is found is a Public holiday in the range or if a weekend
If ((Vlookup(d,lookups!$o$3:$p$26,2,false))=1) or (weekend(d))Then
'minus 8 to remove hours before 8am.
total = (total + Hour(d) + minutes(d) / 60) - 8
End If
Next
Next
End Sub
You are not assigning any values to variables st or en.
Date is not a function available in VBA. You will probably need to use DateSerial function. Here is a simple example of looping over dates which you should be able to modify.
Sub LoopDates()
Dim d As Date
'Loop the days beteween today and March 1, 2013.
For d = DateSerial(Year(Now), Month(Now), Day(Now)) To DateSerial(2013, 3, 1)
Debug.Print d 'Prints the "d" value in the immediate window.
Next
End Sub
Also, you can't just put worksheet formulae in VBA. This line is definitely wrong syntax for Vlookup, and Weekend is not a formula that I'm aware of (testing it seems to confirm it is not a valid call on worksheet or in VBA.
If ((Vlookup(d,lookups!$o$3:$p$26,2,false))=1) or (weekend(d))Then
Rewrite as:
If Application.WorksheetFunction.Vlookup(d,Sheets("lookups").Range("$o$3:$p$26"),2,false)=1 _
or Not Application.WorksheetFunction.Weekday(d) Then
ANOTHER EXAMPLE of a date loop where I have dimensioned the variables in what I believe to be a more efficient manner:
Sub Test()
Dim st As Range
Dim x As Integer
Dim stDate As Date
Dim enDate As Date
Dim d As Date
Dim numRows as Long
NumRows = Range("F2", Range("F2").End(xlDown)).Rows.Count
For x = 0 To NumRows-2
'SET YOUR VARIABLES HERE
' This may seem redundant or unnecessary for this case, but it makes structuring nested
' loops easier to work with, and then there are fewer places to make changes,
' if you need to make changes.
Set st = Range("G2").Offset(x, 0)
Set en = Range("D2").Offset(x, 0)
stDate = DateSerial(Year(st), Month(st), Day(st))
enDate = DateSerial(Year(en), Month(en), Day(en))
'Then, loop through the dates as necessary
For d = stDate To enDate
Debug.Print d
'Do your code here.
Next
Next
End Sub