Somewhat experienced with excel but very new to VBA and looking for some help. I have a range (D:AE) containing dates. Each column has a variable number of rows but the total number of used cells will be no less than ~1500 and may go as high as 10,000. I am trying to create a macro that will find any date within this range greater than 30 days from today and then subsequently clear that same cell's contents. The end result will be dates only falling within the next 30 days. I've done some pretty extensive searching but the limits of my experience haven't left me with much. Any help would be greatly appreciated!
Build a For ... Next loop to look at every column in your sheet, like
For C = 1 To ActiveSheet.UsedRange.Columns.Count
Nest another such loop inside the first, like,
For R = 2 To ActiveSheet.UsedRange.Rows.Count
Within this second loop, each cell is ActiveSheet.Cells(R, C) and you can test and manipulate it. Like,
With ActiveSheet.Cells(R, C)
If IsDate(.Value) Then
If CDate(.Value) > (Date + 30) Then
.Value = ""
End If
End If
End With
Related
Apologies in advance as this is my first time posting something on this site and am not the best at explain issues.
I have a spread sheet, this has production data such as meters daily, meters monthly etc. These values are updated by adding TAGS from a PLC using Rockwell VantagePoint Excel add-in (if your unfamiliar with this it shouldn't matter this part is not what I am struggling with)
I need I way to copy data from one cell to another cell on the same sheet at month end. Basically the Meters monthly field needs to copied into another cell at the end of the month to record meters run for that month. The monthly meters run resets back to 0 at the end of the month.
Basically I need to copy the value in J7 into the corresponding month in W column at the end of that month. If it could ignore the year that would be advantageous as I don't need it to keep the old values and would mean I just need one column.
I have some experience at MS-Excel, also VBA but mainly in MS-Access never in MS-Excel. If answers could be explained as simply and hands on as possible it would be appreciated.
After Googling the issue I came across this formula and changed the ranges to fit my sheet but Excel doesn't like it saying it contains an error
=QUERY( A1:B6; "select B where A =date """&TEXT(TODAY();"yyyy-mm-dd")&""" "; 0
Sorry again if I haven't explained myself properly.
If your workbook isn't guaranteed to be open at the end of each month I would update the value every time it gets opened, like(Should be placed in ThisWorkbook):
'Runs when you open the workbook
Private Sub Workbook_Open()
'Loops through U3 to the last used cell in that column
For Each c In Range(Cells(3, 21), Cells(Rows.Count, 21).End(xlUp))
'Applies the J7 value to the current month and exits the sub
If Month(c) = Month(Now) Then c.Offset(, 2).Value = [J7]: Exit Sub
Next c
End Sub
Also, not that it matters but, I would apply the following formula in U3:U14 to always get the correct dates:
=EOMONTH(DATE(YEAR(TODAY()),ROW()-2,15),0)
Okay, I'm still not super sure what the question is and I know more Access VBA than Excel VBA, but here's something that might help to find a solution.
You can make a check date function that returns a Boolean value:
Public Function EoMonthCheck() As Boolean
Dim eo_month As Date, today As Date
eo_month = Format(WorksheetFunction.EoMonth(Now(), 0), "yyyy-MM-dd")
today = Format(Now(), "yyyy-MM-dd")
If today = eo_month Then
EoMonthCheck = True
Else
EoMonthCheck = False
End If
End Function
And the,, to add a value to the "W" column, we might use something like this:
Public Function AppendValue(Optional target_cell As String = "J7")
''' This could be a subroutine, too, I guess, since we're not returning anything.
Dim i As Integer
''' Activate whatever sheet you want to work with
Worksheets("Sheet1").Activate
If EoMonthCheck() = True Then
''' Look up the bottom of the 'W' column and find the first non-empty cell
''' Add 1 to that cell to get you to the next cell (the first empty one).
i = Cells(Rows.Count, "W").End(xlUp).Row + 1
''' Set the value of that empty cell in the 'W' column to the value of 'J7'
''' which will happen after we evaluate whether it is the end of the month.
Cells(i, "W").Value = Range(target_cell).Value
End If
Then, you could maybe trigger that each time the workbook opens.
I'm trying to avoid copy and paste in order to dramatically speed up a Macro (previously taking two minutes to run). I am trying to reference four entire columns in Sheetx(A,B,J,L) and have them display in sheety(A6,B6,C6,D6).
I have tried a number of variations of
Sheets("Sheety").Range("A6:A,B6:B,C6:C, D6:D").Value = Sheets("Sheetx").Range("A:A, B:B, J:J, L:L").Value
Also, for sheets("sheety") I tend towards Active.Sheet or Sheets(B) as I have used the index number for the sheet ie
For B = 31
31 being the index number for the real sheet.
I have been searching for answers for the last hour. Can anyone help?
Tell me if something like this:
Sub Testy3()
Dim N As Long
N = Sheets("Sheet1").Cells(Rows.Count, "A").End(xlUp).Row
Sheets("Sheet1").Range("A1:A" & N).Copy Sheets("Sheet2").Range("A6")
End Sub
works for you.
If all the columns in Sheet1 have the same number of rows, then you don't need to re-calculate N for each column.
I'm new here and I apologize in advance in my question isn't clear... I couldn't find the answer after some research...
I'm looking for a way to go through all the cells of column "R" and if one cell on a given row contains "Y", then the values of cells at columns "W","X" and "Y" will take the same value as the columns "F","G" and "H" (always at the same row).
The goal is to have a button that will execute the VBA code in order to do this (instead of having to copy/paste all the time).
Thank you very much in advance for your help.
A poor ignorant but motivated VBA beginner...
Here is VBA which will do what you want. It takes advantage of the replacement operation being cells that are next to each other by using Resize.
Highlights
Iterates through each cell in column R. I used Intersect with the UsedRange on the sheet so that it only goes through cells that have values in them (instead of all the way to the end).
Checks for "Y" using InStr.
Replaces the contents of columns WXY with values from columns FGH. Since they are contiguous, I did it all in one step with Resize.
Code:
Sub ReplaceValuesBasedOnColumn()
Dim rng_search As Range
Dim rng_cell As Range
'start on column R, assume correct sheet is open
Set rng_search = Range("R:R")
For Each rng_cell In Intersect(rng_search, rng_search.Parent.UsedRange)
'search for a Y, case sensitive
If InStr(rng_cell, "Y") > 0 Then
'update the columns as desired
'takes advantage of cells being next to each other
Range("W" & rng_cell.Row).Resize(1, 3).Value = Range("F" & rng_cell.Row).Resize(1, 3).Value
End If
Next rng_cell
End Sub
I tested it on my end, and it works, producing the following after running:
Apologies beforehand for this, I'm very new to VBA and I'm sure this is simple coding that I'm struggling with.
Based on a user defined number of months (just entered into the ssheet) I have a row of column headings giving the month number and the heading "Total" after the last month.
i.e. User says 12 months, cell A2 = "Jan-15" and M2 = "Total".
Underneath the headings the user then adds some sales data.
What I need to do is use VBA to add a total to the end of each of the rows of data where the header = "total".
I was thinking an If Then makes sense but I'm struggling with how to get the macro to put the formula in the correct cell and then have the formula look at the variable range. This is the best I've come up with so far (please don't laugh!)
Sub Add_total()
Dim criteria As String
criteria = Range("A:A").Value
If criteria = "Total" Then
Range("12:12").Select
ActiveCell.Formula = "=sum($c12:c12)"
End If
End Sub
What I'd like is, for example, where M2 = "Total", then C12 = sum(c1:L12)
I realise the easiest way would be to just get the user to add the total themselves or have a total column far away to the left of the sheet but this is going across the business and needs to restrict manual input/guarantee accuracy of the calcs.
Any help much appreciated.
Why not simply put in cell M3 the function =sum(A3:L3) and copy downwards?
If you need it in VBA anyway should this work:
Sub testsum()
i = 3 'start in cell3
While Not IsEmpty(Cells(i, 1))
Cells(i, 13) = WorksheetFunction.Sum(Range((Cells(i, 1)), (Cells(i, 12))))
i = i + 1
Wend
End Sub
Thanks very much for that - not quite what I needed but you pointed me in the direction. Went for the following in the end:
Sub Total() Set Find_total = Range("6:6").Find("Total",_
LookIn:=xlValues,searchorder:=xlByColumns)
Set Revenue_total = Find_total.Offset(rowoffset:=3, columnoffset:=-1)
Set Revenue_cell = Find_total.Offset(rowoffset:=3, columnoffset:=0)
Revenue_cell = WorksheetFunction.Sum(Range((Cells(9, 2)), Revenue_total))
End Sub
Thanks again
I am completely new to Excel VBA, and I need to write code to do a simple task. I need to compare values in two different columns row by row, and see if the difference exceeds 50. If so, I need to highlight the entire row.
I program in other languages, so I have a basic understanding for how this works, but I have no clue how to navigate cells/view the content inside the cells. I tried this but it didn't work out (it would just highlight every single row). I simplified it to compare if values are equal or not, but to no avail (still everything is highlighted) Can anyone give me some help?
Dim strF0_col As Integer, sF0_col As Integer
Dim myRow, counter As Integer
Dim rEnd As Integer
Sub compare_F0()
rEnd = 100
strF0_col = 307
sF0_col = 317
counter = 0
For myRow = 2 To rEnd Step 1
Application.StatusBar = counter & "rows highlighted."
If (Cells(myRow, strF0_col).Value = Cells(myRow, sF0_col).Value) Then
Cells(myRow, strF0_col).EntireRow.Interior.ColorIndex = 28
End If
Next myRow
End Sub
Thanks in advance
Is there any reason to do not use Conditional Formatting, as #Doug Glancy suggested?
It worked quite fine here for me.
In case you want to give it a shoot, do as follows...
Choose the whole row
Open Conditional Formatting Menu (will depend on your Excel version. Anyway...)
Add the Rule =$KU2>$LE2+50
Set the format you want (maybe fill in yellow?)
Confirm
Copy format to other rows
Notice the row index (2, in this case) cannot have the $ symbol.
Hope it helps.
You probably don't want to highlight rows that are blank?
If so, use
If Cells(myRow, strF0_col).Value <> "" And _
Cells(myRow, strF0_col).Value = Cells(myRow, sF0_col).Value Then
As an aside, accessing cell values like this is quite slow. If you are only processing 100 rows then its fast enough, but if this number grows then you will find it slows down to a painful degree.
It is much faster to copy the range values to a variant array an then loop over that. Search SO for [Excel] "Variant Array" There are many answers that show how to do this and explain why it helps