Excel Macro: Selecting a specific Row based on column date - vba

I am writing my first macro and have a question on how I can select a specific Row based on a value in a specific column. here is my code so far:
Sub Pipeline()
'Module 3
'Iterating through the Funding Date Column and looking for clients going live within 30 days
'Selecting the rows for each client in that target range
'TODO: Export information into an email template in Outlook
'TODO: Send email to distribution list
Dim fundingDate As range
Set fundingDate = range("M4:M500")
Dim todaysDate As Date
todaysDate = Date
For Each cell In fundingDate
If cell < todaysDate + 30 Then
'Need to select the entire row
Else
cell.Font.ColorIndex = 3
End If
Next
End Sub

replace 'Need to select the entire row with
cell.entirerow.select
UPDATE
Here is a much more efficient way to get what you need without all the looping.
In your code Replace from For Each cell ... to Next with this:
With fundingDate
.AutoFilter 1, "<" & todaysDate + 30
.SpecialCells(xlCellTypeVisible).Select
'here are your clients going live in next 30 days
.AutoFilterMode = False
End With
You may need to provide some error checking in case you don't have clients going live within 30 days (SpecialCells method will fail on this) and also, if M4 is not your column header, you may want to adjust how the range picks up the visible cells.

Related

Excel VBA Code for small scroll while there is a value on the right

I have a Macro that takes data out of 2 reports.
in the second report I have dates that I copy. I need to take a date and subtract from it 14 days
I go to first blank cell in column D, then I want to calculate the formula in column C and scroll down without type how many cells (because it is a macro to a daily basis and the amount of data will change). I want to do this until the end of the data I copied.
In the end I want to copy it as values to column B.
Here is what I have in my code(part of all macro):
'first we go to the buttom of the column
'for NOW - change manually the top of the range you paste to
'Now, paste to OP_wb workbook:
OP_wb.Sheets("Optic Main").Range("D1").End(xlDown).Offset(1, 0).PasteSpecial
Paste:=xlPasteValues
' Calculate Due Date to MFG tools
' it means date we copied from MFG daily minus 14 days
_wb.Sheets("Optic Main").Activate
Range("C1").End(xlDown).Offset(1, 0).Activate
ActiveCell.FormulaR1C1 = "=RC[1]-14"enter code here
You need to loop from the first row to the last row. In general, there are plenty of good ways to define the last row of a given column. Once you have done it, replace the value of lngEndRow and run the following code:
Option Explicit
Public Sub TestMe()
Dim lngStartRow As Long: lngStartRow = 1
Dim lngEndRow As Long: lngEndRow = 100
Dim rngMyRange As Range
Dim rngMyCell As Range
With ActiveSheet
Set rngMyRange = .Range(.Cells(lngStartRow, 5), .Cells(lngEndRow, 5))
End With
For Each rngMyCell In rngMyRange
rngMyCell.FormulaR1C1 = "=RC[1]-14"
Next rngMyCell
End Sub
Then change the ActiveSheet with the correct sheet and the column hardcoded as 5 with the correct one. Run the code above in an empty Excel, to understand what it does. Then change it a bit, until it matches your needs.

How do I insert multiple date columns in order to meet a specific date?

I am really new to codes and Excel VBA, and hopefully, you guys could help me out with my question. Any tips, feedback, and comments are greatly appreciated!
Within a workbook, I want to make sure that my cell (I1) of worksheet (Sheet1) has the specific date as written in a different sheet (ie. Menu). I want I1 to be the starting point whereby subsequent dates will occur by going across the row (I1, J1, K1, etc.). In this case, if my specific date required is 15/8/16 and one of my sheet (Sheet 1) has its cell I1 written as 20/8/16, I want to know how to construct my code in such a way that,
If I1 in Sheet 1 is currently at 15/8/16, then do nothing. But if I1 in Sheet 1 is off a different later date than 15/8/16, the I1 will now begin at 15/8/16, and subsequent dates are added until it reaches the default date that was initially there at I1 (now 20/8/16 is at cell N1).
My current code is as follows:-
If ActiveSheet.Range("I1") <> MainSht.Range("D6") Then
ActiveSheet.Range("I1") = MainSht.Range("D6")
End If
Do
If Cells(1,z+1)>Cells(1,z+1) Then
Cells(1,z+1) = Cells(1,z)+1
End If
z = z+1
Loop Until Cells(1,z+1) = MainSht.Range("D7")
*Mainsht (D6) is my start date, (D7) is my end date.
My code currently does not have the insert column section because I have problems in applying both insert column and date increment code together. With my current code, my date range never expanded as it is still within the same earlier date range (same last column as before, hence last cell for date column remains as it is). How do I construct in such a way that the missing dates in between are added, and it is added by inserting columns in a repeated process?
Thanks in advance if anyone could help me out in this. Thanks for your understanding as well.
Please check below code to add columns
Dim start_date, end_date As Date
start_date = ThisWorkbook.Sheets("Sheet1").Range("L1").Value
end_date = ThisWorkbook.Sheets("main").Range("D7").Value
If start_date < end_date Then
Do Until start_date = end_date
ThisWorkbook.Sheets("Sheet1").Activate
Range("L:L").Insert (xlRight)
start_date = start_date + 1
Range("L1").Value = start_date
Loop
End If
you could try this:
Option Explicit
Sub main()
Dim diff As Long
With Worksheets("Work").Range("I1") '<--| reference working sheet range "I1" (change "Work" to your actual working worksheet)
diff = .Value - Worksheets("Menu").Range("D6") ' <--| evaluate the difference between referenced range value and worksheet "Menu" cell "D6" (change "Menu" to your actual "main" sheet)
If diff > 0 Then
With .Resize(, diff) '<-- reference referenced range resized to the necessary columns number
.EntireColumn.Insert xlRight '<-- insert columns
With .Offset(, -diff).Resize(1) '<--| reference referenced range first row
.FormulaR1C1 = "=RC[1]-1" ' <--| insert formulas that substracts one from the value of next cell on the right
.Value = .Value '<-- get rid of formulas
.NumberFormat = .Offset(, diff).Resize(, 1).NumberFormat '<--| format cells as the passed range
.EntireColumn.AutoFit '<--| adjust columns width
End With
End With
End If
End With
End Sub
Just change "Work" and "Menu" to your actual worksheets names

Break from for loop back into if statement vba

I am trying to perform an action that will see if the date in range (dateRng) is less than today's date, and then, if it is, perform the for loop to hide the rows w.here a value in the column is zero. (I am paying off loans, and every month I want it to hide any loans that have been paid off.) Months are across columns, loans are in rows. Loan balance is (i, j).
The problem is that it never exits the for loop to go back and check the date after every new 'j' (column). It just stays in the for loop. I have tried break, exit, continue, etc. None seem to work, at least where I place them. How do I get it to check for the date, compare to 'today', THEN run the for loop to check each cell in the column, before moving on to column 2, checking the date and performing the same for loop.
It would be good to have it be dynamic, but that is not necessary, as every month I could just change the ranges in the code. This is strictly for my personal use. Any help is appreciated. thank you.
Sub hidePaid()
Dim day As Range, loanRng As Range, loanSum As Worksheet, dateRng As Range, cel2 As Range, i As Long, j As Long, col As Range
Set loanSum = ThisWorkbook.Worksheets("Loan Sum")
loanSum.Activate
Set dateRng = ActiveSheet.Range("D2:R2")
Set loanRng = ActiveSheet.Range("D4:R16")
For Each day In dateRng
If day.Value < Date Then
For j = 1 To loanRng.Columns.Count
For i = 1 To loanRng.Rows.Count
If loanRng.Cells(i, j).Value < 1 Then
loanRng.Cells(i, j).EntireRow.Hidden = True
End If
Next i
Next j
End If
Next
End sub
I added comments in the code to show my changes.
You were close, but had one to many loops and like you say, needed to find the right place for the exit.
Sub hidePaid()
Dim day As Range
Dim loanRng As Range
Dim loanSum As Worksheet
Dim dateRng As Range
Dim i As Long
Set loanSum = ThisWorkbook.Worksheets("Loan Sum")
loanSum.Activate
Set dateRng = ActiveSheet.Range("D2:R2")
Set loanRng = ActiveSheet.Range("D4:R16")
'This loop processes by column
For Each day In dateRng
'Once the date in the column is greater than today, it will stop processing
'It assumes the values in dateRng are valid dates
'(I.e. '01/01/2016' not just 'Jan', you can use number format in Excel to
'get a date to show as 'Jan' if that is better for you)
If DateDiff("d", Now(), day.Value) > 0 Then Exit For
'The line of code you had should have worked in sense,
'it would have touched every column but only procesed those before today
'It also assumes that value in the cell to be an actual date
'If day.Value < Date Then
'You do not need a column loop here as you are already in one in the
'previous loop
'For j = 1 To loanRng.Columns.Count
'This loop processes all the rows that are not already hidden and if
'the value is equal to 0 then it hides the row
'Note: you had the check to be less than 1, .50 is less than 1 and you don't
'want to get caught out on a loan!
For i = 1 To loanRng.Rows.Count
If (loanRng.Cells(i, day.Column - 3).Value = 0) And (loanRng.Cells(i, day.Column - 3).EntireRow.Hidden = False) Then
loanRng.Cells(i, day.Column - 3).EntireRow.Hidden = True
End If
Next i
Next
'Its good practice to clear out resources when finishing
Set dateRng = Nothing
Set loanRng = Nothing
Set loanSum = Nothing
End Sub

How do I grab the string and adjacent number in multiple columns

I want to run a loop to group the text by certain criteria and add up a total, but I need to be able to grab both bits of data.
Connecticut 624
Georgia 818
Washington 10
Arkansas 60
New Jersey 118
Ohio 2,797
The selection would be something like that, and I want the user to be able to highlight the two columns and I will run through and group the States by location and add the totals
edit--
So far, all I've been able to do is grab what the user selected range is:
Sub Short()
Dim rngMyRange As Range
If TypeName(Selection) = "Range" Then
Set rngMyRange = Selection
Else
Exit Sub 'Non-range type selection e.g. a chart
End If
MsgBox "The address of rngMyRange is " & rngMyRange.Address(False, False)
End Sub
I have a formula in another sheet that checks the states for their group, but it's one cell at a time
=IF( AND(D9="", B9="USA"),"",IF(B9="USA",IF(COUNTIF(Legends!$B$4:$B$13,D9)>0,"US Group 1",IF(COUNTIF(Legends!$F$4:$F$15,D9)>0,"US Group 3","US Group 2")),IF(COUNTIF(Legends!$H$4:$H$6,B9)>0,"Int'l Tier 1",IF(COUNTIF(Legends!$J$4:$J$15,B9)>0,"Int'l Tier 2","Int'l Tier 3"))))
Using the for loop below will loop through each cell in your range (selection - make sure you select just the column with the names in it)
Sub Short()
Dim rngMyRange As Range
Dim ttl as integer
Dim c
If TypeName(Selection) = "Range" Then
Set rngMyRange = Selection
Else
Exit Sub 'Non-range type selection e.g. a chart
End If
for each c in rngMyRange
ttl = ttl + c.offset(0,1)
next c
End Sub
You'll need to change the for loop with your criteria. This could be done a lot easier though by using a pivot table on your data range.

Excel to CountIF in filtered data

I am trying to count the number of occurrences of a specific string in filtered data. I can do it using a formula in a cell but when I combine that with the other macros in my workbook the whole thing freezes.
So I would like to move the calculation to VBA so that it only calculates when the macro is run. Here is the formula that works in the cell:
=SUMPRODUCT(SUBTOTAL(3,OFFSET('2015 Master'!H:H,ROW('2015 Master'!H:H)-MIN(ROW('2015 Master'!H:H)),,1)),ISNUMBER(SEARCH("*Temp*",'2015 Master'!H:H))+0)
Basically I want to count the number of times "Temp" occurs in column H but only in the filtered data.
Thank you for your help!
ADDITION:
Here is the code I've written for the macro so far. It filters the data on a different sheet then updates the pivot table with the date range. I would like to add the count calculations to the end of this code and return the count to a cell on the 'Reporting' sheet.
Sub Button1_Click()
'Refresh the pivot table and all calculations in the active sheet
ActiveWorkbook.RefreshAll
'Gather the start and end times from the active sheet
dStart = Cells(2, 5).Value
dEnd = Cells(3, 5).Value
'Change the active sheet to the alarms database, clear all filters and then filter for the defined date range and filter for only GMP alarms
Sheets("2015 Master").Select
If ActiveWorkbook.ActiveSheet.FilterMode Or ActiveWorkbook.ActiveSheet.AutoFilterMode Then
ActiveWorkbook.ActiveSheet.ShowAllData
End If
ActiveSheet.ListObjects("Table44").Range.AutoFilter Field _
:=3, Criteria1:=">=" & dStart, Operator:=xlAnd, Criteria2:= _
"<=" & dEnd
Range("Table44[[#Headers],[GMP or non-GMP]]").Select
ActiveSheet.ListObjects("Table44").Range.AutoFilter Field:=2, Criteria1:= _
"GMP"
'Change the active sheet to the Reporting sheet
Sheets("Reporting").Select
'Within the alarms pivot table clear the label filters then filter for the date range and GMP alarms
ActiveSheet.PivotTables("PivotTable1").PivotFields("Active Time"). _
ClearLabelFilters
ActiveSheet.PivotTables("PivotTable1").PivotFields("Active Time").PivotFilters. _
Add Type:=xlDateBetween, Value1:=dStart, Value2:=dEnd
ActiveSheet.PivotTables("PivotTable1").PivotFields("GMP or non-GMP"). _
CurrentPage = "GMP"
End Sub
Pertinent to clarified question topic (i.e. " Basically I want to count the number of times "Temp" occurs in column H..."), the VBA solution can be as shown in the following code snippet. Assuming sample data entered in Column "H":
H
Temp Directory on C: Drive
Temp Directory
Project Directory
Output Temp Directory
Start Directory
Temp obj
apply the VBA Macro:
Sub CountTempDemo()
Dim i As Integer
Dim count As Integer
Dim startRow As Integer
Dim lastRow As Integer
Dim s As String
startRow = 2 'or use your "filtered range"
lastRow = Cells(Rows.count, "H").End(xlUp).Row 'or use your "filtered range"
count = 0
For i = 2 To lastRow
If InStr(Cells(i, 8).Value, "Temp") > 0 Then
count = count + 1
End If
Next
End Sub
where count value of 4 is a number of "Temp" occurrences in specified "H" range.
Hope this may help. Best regards,
To iterate over a column and find only visible (unfiltered) cells, one way is this:
Set h = ... Columns ("H");
Set r = h.SpecialCells(xlCellTypeVisible)
' now r is a composite range of potentially discontiguous cells
' -- it is composed of zero or more areas
'but only the visible cells; all hidden cells are skipped
Set ar = r.Areas
for ac = 1 to ar.Count
Set rSub = ar(ac)
'rSub is a contiguous range
'you can use a standard formula, e.g. Application.WorksheetFunction.CountIf(...)
'or loop over individual elements
'and count what you like
next
caveats: if any rows (or the column) are hidden manually (not from filtering) the count using this method will consider them as filtered (i.e. hidden/not visible).
Update: answer to comment
A Range is really a very general purpose notion of an aggregation of cells into a grouping or collecting object (the Range). Even though we usually think of a Range as being a box or rectangle of cells (i.e. contiguous cells), a Range can actually assemble discontiguous cells.
One example is when the user selects several discontiguous cells, rows, and/or columns. Then, for example, ActiveSheet.Selection will be a single Range reflecting these discontiguous cells. The same can happen with the return value from SpecialCells.
So, the Excel object model says that in general, a Range can be composed of Areas, where each Area itself is also represented by a Range, but this time, it is understood to be a contiguous Range. The only way you can tell if the Range is contiguous or not is if you created it as a box/rectangle, or, if Areas.Count = 1.
One way to investigate a bit more might be to select some discontiguous cells, then enter a macro and use the debugger to observe Selection.