I have an excel sheet with lots of data. As you may know, this comes with lots of problems. One major one is having too much data. I am not familiar with vba, but I wanted to know how to clean data.
I have a sheet with 3 fields: date, time, and temp. The temperature is recorded on a minute by minute basis. The temperature is only recorded from 7 am to 10 pm, but the sheet is on a 24 hour basis. So my sheet has a lot of blank cells. So, I want to write a code that states:
if ((time < 7am) or (time > 10pm)):
delete row
Can I do this?
Also, another problem is that the data is not collected on weekends. I am not given a day field, only a date field in this format: 20130102 which is January 02 2013. I want to:
if ((date = saturday) or (date = sunday)):
delete row
Are either of these doable?
My sheets looks like the following:
A .............. B ......... .... C
date........ time ......... temp
Since both your dates and times are formatted differently than normal, we need to manipulate the values to get something to test against. Consider the following example (I've commented each line to help you follow along):
Sub DeleteRows()
Dim lastRow As Long
Dim Cell As Long
Dim dt As Date
'Work with the active sheet.
With ActiveSheet
'Find the last row of your dataset.
lastRow = .Range("A:A").Find("*", searchdirection:=xlPrevious).Row
'Format your time column to a readable time.
.Columns("B").NumberFormat = "[$-F400]h:mm:ss AM/PM"
'Loop through the rows, beginning at the bottom.
For Cell = lastRow To 2 Step -1
'Piece together the date.
dt = Mid(.Cells(Cell, 1), 7, 2) & "/" & _
Mid(.Cells(Cell, 1), 5, 2) & "/" & Left(.Cells(Cell, 1), 4)
'If the date is a Sat or Sun, delete the row.
If Weekday(dt) = 1 Or Weekday(dt) = 7 Then
.Rows(Cell).EntireRow.Delete
'If the time is before 7am or after 10pm, delete the row.
ElseIf Hour(.Cells(Cell, 1)) < 7 Or Hour(.Cells(Cell, 1)) > 22 Then
.Rows(Cell).EntireRow.Delete
End If
Next Cell
End With
MsgBox "Done!"
End Sub
A few things to note about the code. First, we must start at the bottom of the list because as we delete rows, the remaining rows shift upwards. If we were to go from top to bottom (e.g. A1 to A10), if we deleted row 5, row 6 would slide into its place, and the loop would skip row 5 (previously row 6) and go on to row 6. In other words, looping from top to bottom when deleting rows will ultimately skip rows unintentionally.
Second, I had to guess on your time format. While I believe I guessed correctly, I may not have. If I was wrong and my code doesn't change the time column into a readable time, record a macro while changing the format of that column and substitute the new format with mine ("[$-F400]h:mm:ss AM/PM"
).
And lastly, since your date column is an abnormal format (for Excel), we need to reorder the date so that Excel can read it. Once we've done that, we can use the resulting date to see if the date was a Sat. or Sun.
You can do it this way, assuming the column that contains your date is the 2nd (B) :
Dim i As Integer
for i = 1 to cellsCount
If Hour(Cells(i, 2)) < 7 Or Hour(Cells(i, 2) > 22 Then
Rows(i).Delete
Else If WeekDay(Cells(i, 2)) = 7 Or WeekDay(Cells(i, 2)) = 1 Then
Rows(i).Delete
End If
next
You can have more information about the WeekDay function here :
http://msdn.microsoft.com/en-us/library/82yfs2zh%28v=vs.90%29.aspx
Related
I am fairly new at VBA and I am currently trying to rework an existing macro that sums hours of a workday up by employee for the week.
I need a macro that will sum up the work hours by just a single day instead of a weekly total. There are two entries per day for each employee. Then, this total is copy and pasted into a different column.
I can not use a pivot table as this macro will be used on a different spreadsheet every week. I also can not have a reference sheet. This is going to be applied to a spreadsheet that is emailed every week, so it is constantly changing.
Basically... if the date in Column B is the same, I need the sum of hours in Column C, then that Sum is pasted over to a new column (D is fine).
Below is what the original report looks like at this point:
A B C
Joe Smith -- 03/26/2018 -- 3.65
Joe Smith -- 03/26/2018 -- 4.46
Joe Smith -- 03/27/2018 -- 5.45
Joe Smith -- 03/27/2018 -- 2.93
The existing macro is :
For Each x In n.Range(n.Range("B2"), n.Range("B" & Rows.Count).End(xlUp))
x.Value = Month(x.Value) & "/" & Day(x.Value) & "/" & Year(x.Value)
Next x
For Each x In n.Range(n.Range("J2"), n.Range("J" & Rows.Count).End(xlUp))
Set r = n.Range(x.Address)
r.Offset(0, 1).Value =
Format(Application.WorksheetFunction.Max(n.Range(n.Range("B2"), n.Range ("B" & Rows.Count).End(xlUp))), "MM/DD/YYYY")
r.Offset(0, 2).Value = Application.WorksheetFunction.SumIf(n.Range("A:A"), x.Value, n.Range("E:E"))
For I = 3 To UBound(TableHeaders)
ch = TableHeaders(I)
r.Offset(0, I).Value = Application.WorksheetFunction.SumIfs(a.Range("R:R"),
a.Range("L:L"), ch, a.Range("A:A"), x.Value)
Next I
d.RemoveAll
Next x
I can not use a pivot table as this macro will be used on a different
spreadsheet every week.
well, this is not a reason. You could run change source for pivot table any time.
This is going to be applied to a spreadsheet that is emailed every week
But at least layout of the workbooks is preserved?
The simplest way is to use formula:
=SUMIFS(C:C, A:A, A2, B:B, B2)
Paste it to D2 and drag down. You could also put formulas to A:C that just refers to proper values in source file, like:
=[WorkbookFromEmail.xlsx]Sheet1!A2
and drag it left to C and down to as many rows as you think you will need and some more. Then you could only change the name of linked file in Data/Edit Links.
As far, you don't need VBA. But you could make some macro for refreshing links to other workbook if you found manual job too troubling. This is however different story.
Alternatively, you could save the source file always under the same name, like BookFromMail.xlsx and then open the master file with formulas and refresh it.
Here's an all code way. You'll have to adjust the code to find the range you want to read and also figure out where to write to.
Sub SumEeDays()
Dim vaValues As Variant
Dim i As Long
Dim dc As Scripting.Dictionary
Dim sKey As String
'set a reference to the MS Scripting Runtime
'then you wont get an error on this line
Set dc = New Scripting.Dictionary
'Make a 2d array of the values you want process
vaValues = Sheet1.Range("a1").CurrentRegion.Value
'loop through the 2d array
For i = LBound(vaValues, 1) To UBound(vaValues, 1)
'create a unique key to keep track of ee name and date
sKey = vaValues(i, 1) & "||" & vaValues(i, 2)
If dc.Exists(sKey) Then
'If the key already exists, add the hours to what's there
dc.Item(sKey) = dc.Item(sKey) + vaValues(i, 3)
Else
'If the key doesn't exist, create it and add the hours
dc.Add sKey, vaValues(i, 3)
End If
Next i
'Loop through the dictionary of unique name/dates
For i = 1 To dc.Count
With Sheet1.Range("J1")
'Keys returns an array and Split splits it on "||"
'The 0th element of the array is the name
'The 1st element is the date
.Offset(i - 1, 0).Value = Split(dc.Keys(i - 1), "||")(0)
.Offset(i - 1, 1).Value = Split(dc.Keys(i - 1), "||")(1)
.Offset(i - 1, 2).Value = dc.Items(i - 1)
End With
Next i
End Sub
At the end of every month, we copy/paste forecast sales (where the formulas are) as a hardcode into other columns for reference and reconciliation purposes.
For example, copy Column D (January) through Column F (march) into column Q (Jan hardcoded) through S (March hardcoded)
I'm trying to modify my code so the user can select from two data validation dropdowns which month range (e.g. Jan - Mar) on each of the forecast tabs to copy/paste as values.
For example, below is something I've added to copy/paste based on the # rows for a formula.
Dim LastRow As Long
With ActiveSheet
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
End With
Range("T1") = "PPU"
Range("T2") = "=S2/R2"
Range("T2").Copy
Range("T2:T" & LastRow).Select `dynamic row
Selection.PasteSpecial xlFormulas
Range("T:T").Copy
Range("T:T").PasteSpecial xlPasteValues
With my code above, is it possible to alter this so, instead of " & Lastrow", I keep the rows static but make the columns to copy variable, so for lack of a better term firstMonth & secondMonth.
The columns to select would be based off two named ranges where the user chooses from two data validation lists (firstMonth & secondMonth) with each column being assigned a column "letter" (e.g. Jan is column D, Feb Column E, etc.)
Without being dynamic, it would be something like:
Range("D12:F19").Copy
Range("Q12").PasteSpecial xlValues
But I'd like to have the user select with months, via a data validation list, to have hardcoded by choosing a beginning month (firstMonth) and ending month (secondMonth)
Something along the lines of:
Range(firstMonth &"12": secondMonth & "19").Copy `firstMonth in theory is the column letter so, "D12" and secondMonth is the second column letter (F12)
Range("pasteFirstMonth &"12").PasteSpecial xlValues `the firstMonth will be paired with the column letter, say "Q" where it will paste those values. A second column range isn't needed here since only the copied range will paste, not overlapping anything else. This is the "hardcoded" area.
Update: Slightly reconfigured Tim's answer below.
Sub copyColumns()
Dim months, m1, m2, sht
months = Split("Jan,Feb,Mar,Apr,May,Jun,Jul,Aug,Sep,Oct,Nov,Dec", ",")
Set sht = ActiveSheet
m1 = Application.Match(sht.Range("Month1").Value, months, 0)
m2 = Application.Match(sht.Range("Month2").Value, months, 0)
sht.Range(sht.Cells(8, 3 + m1), sht.Cells(16, 3 + m2)).Copy
sht.Range(sht.Cells(8, 16 + m1), sht.Cells(16, 16 + m2)).PasteSpecial xlValues
End Sub
Something like this should work:
Sub DoCopy()
Dim months, m1, m2, sht
months = Split("Jan,Feb,Mar,Apr,May,June,July,Aug,Sept,Oct,Nov,Dec", ",")
Set sht = ActiveSheet
m1 = Application.Match(sht.Range("Month1").Value, months, 0)
m2 = Application.Match(sht.Range("Month2").Value, months, 0)
If Not IsError(m1) And Not IsError(m2) Then
'copy range - use offset (3 here) depending on where months begin
sht.Range(sht.Cells(12, 3 + m1), sht.Cells(19, 3 + m2)).Copy
'etc
End If
End Sub
You can prompt the user for selecting the desired months and you can use the Selection object, like
Set rng=Selection
Cells(rng.row, rng.column) gives you the top left cell of the selection,
rng.Columns.Count gives you the number of columns, etc.
From a users perpective it is much easier to select an area on the screen and press a button than entering values or selecting them from list.
I'm trying to run a For Next loop that pulls specific numbers from specific cells in order to calculate total hours for a time card using Excel (it's the best program for what I'm using it for). I cannot, however figure out how to do it because I'm using R1C1 because I'm running the a count for the locations. I am not hidebound to this particular method of doing things, but a variation on it worked in Access (but I can't use Access for this because, reasons).
Attached is the code snippet I'm using.
For Weekday = 11 To 17 'Determine the day of the week by Row Reference (R1C1 format)
For DayValue = 29 To 34 'Determin time input (Call, Meal In, Meal Out, Wrap, etc.) for day of the week
WrkTimes(DayValue) = ActiveSheet.Cells.FormulaR1C1 = "R" & (Weekday) & "C" & (DayValue) 'Select the correct time input
Next DayValue 'Process the next time input
TotHrs(Weekday) = WrkTimes(34) - WrkTimes(29) - (WrkTimes(31) - WrkTimes(30)) - (WrkTimes(33) - WrkTimes(32)) 'Calculate total hours for the day
ActiveSheet.Cells(Weekday, 37) = TotHrs(Weekday) 'Display total hours for the day in the proper cell
Yes there is a Next command at the bottom of this loop, I just have other non-relevant code between this and the end. I'm getting the error on the DayValue lines
My first suggestion is to use
Cells(r, c)
Then you can put in your offsets such as
Cells(r-3, c)
You would just need to store the r and c values, which you've done as Weekday (r) and DayValue (c).
In the case if what you're looking at with the loop:
Cells(Weekday, DayValue).Value
This would give the value in the cell you've referenced.
Edit:
Suggestion from my comment:
Dim i as Long, j as Long, k as Long
For Weekday = 11 To 17
i = Cells(Weekday, 34).Value 'Should allow you to have an output for each row
For DayValue = 33 To 29 Step -1 'Saving column 34 outside of the dayvalue loop
j = i
k = Cells(Weekday, DayValue).Value
i = j - k
Next DayValue
Cells(Weekday, 37).Value = i
Next Weekday
So, to clarify why I kept getting the subscript out of range (after following the suggestions from Scott and Phylogenesis), it turns out that my Weekday(x) was set for 7 when it should have been set at 17.
Thanks for all the help.
I'm new to this site as well as to VBA. I've been working on a project and have run into a wall. I hope someone can help me out. What I'm trying to do is create a loop that will go through the specified sheet and pull data that matches my criteria, copy and paste it to another sheet, where I will be calculating it and then showing the results of the calculations in another sheet.
so, I have the following code (excel VBA) that is suppose to go through the sheet and pull all records that match the current week (I'm also trying to add the current year, no luck so far) and paste all matching records to the sheet named Archieve:
Sub DataByWeek()
Dim cw As Integer ' current week
Dim cy As Integer ' current year
Dim lr As Long 'last row of data
Dim i As Long ' row counter
'Get week number of today's date
cw = Format(Date, "ww")
cy = Format(Date, "yyyy")
ActiveWorkbook.Worksheets("Daily DB").Activate
' Find last row of data plus one down
lr = Sheet7.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
For i = 2 To lr
If Cells(i, 6) = cw Then
Range(Cells(i, 1), Cells(i, 5)).Copy
ActiveWorkbook.Worksheets("Archieve").Activate
Range("A2").End(xlUp).Offset(1, 0).PasteSpecial xlPasteFormulasAndNumberFormats
End If
Next i
End Sub
This code does everything I want it to do except return beyond the first matching iteration. The code does go through all data on the sheet named Daily DB, but only returns the first matching record. I've tried looking online (many site including this one) to see if I missed something or did something wrong, but I can't find where I went wrong.
I would also like to know how I can add a second criteria to the If statement condition. I'd like to add the year so that the condition reads something like
If Cells(i, 6 & 7) = cw & cy Then
...
Where i, 6 contains the week number and i, 7 contains the year. In other words, I'd like to 'say' find all records that contain the x week of x year.
Sorry if this was too long and thank you in advanced for any and all help.
If you add ActiveWorkbook.Worksheets("Daily DB").Activate before the End If statement, I believe it would fix your problem. I'm not sure it's the most efficient way though.
So I'm having two issues that I cannot seem to get unkinked. I run reports from a master sheet based off of a template and each finished sheet will have varying numbers of rows. What each finished sheet has in common are two columns(one for a begin date [Column F] and on for an expiration date[Column H]). For each row with a date in Column F I need to add 60 days to the date and put that date in Column H. I have tried working with variations of:
Dim cell As Range
For Each cell In Selection
cell.Value = cell.Value + 60
Next cell
I have tried this also with combinations of different while statements that I use for other things where I am putting values in one column based off of another, but I can't get them to work either.
Some of the problems I am having are: first, when I do manage to get it to enter a date in Column H it always enters 2/29/1900. It doesn't matter if there's a date in Column F or not, or what that date is. Second, when I try to set a range for the selection (this is when I try to combine with "While" statements) it pastes a date number in the entire range instead of only the cells with a date in Column F.
How can I get the macro to only add a date in Column H if there is a date in Column F, and how can I get the darn thing to add 60 days correctly?
Sub Tester()
Dim c As Range, val
For Each c In ActiveSheet.Range("E2:E100")
val = c.Value
If Len(val) > 0 And IsDate(val) Then
c.Offset(0, 2).Value = val + 60
End If
Next c
End Sub