I've tried for days to find an answer to this but honestly, it might be a lack of knowledge in the subject that's causing me to not search for the right terms.
I have a spreadsheet with a series of dates between S7:GE7 and rows from 8:96 that have data that need to be locked the next day.
I know my way of selecting the columns is all wrong, and there's probably more wrong too but I can't think of a way to make it right.
Private Sub Workbook_Open()
Dim i As Range, cell As Range
Set i = Range("S7:GE7")
For Each cell In i
If (cell.Value < DateValue(Now())) Then
Range(i + "8:96").Locked = True
End If
Next cell
End Sub
What I'm hoping to achieve with this is a loop that looks through the dates in S7:GE7, and if the date is older than today it locks cells 8:96 in that column.
Any help that can be provided would be much appreciated. Thanks
Try this:
Private Sub Workbook_Open()
Dim i As Range, cell As Range
Set i = Range("S7:GE7")
For Each cell In i
If (cell.Value < DateValue(Now())) Then
cell.Offset(1, 0).Resize(79, 1).Locked = True
End If
Next cell
End Sub
Related
I'm programming a table to display rows based on numeric values in one cell and text values in another (a drop down list). I completed the code for the rows, but can't seem to get my head around the columns.
Edit: What I'm trying to do is display one or two of many columns depending on what input value I have in a dropdown. At the same time as the number of rows displayed are dependent on another cell. E.g. if I have three types of candy, one per column. And in the rows I display how many of said candies I eat per day. I want to display only one of the candies, for x days. How do I code this? The row-part I solved, the column - i need help.
This is my current code, how should I go about solving my predicament?
Private Sub Worksheet_Change(ByVal Target As Range)
Application.ScreenUpdating = False
If Not Intersect(Target, Range("Time_horizon")) Is Nothing Then
TH_row_update
TH_column_update
End If
End Sub
Public Sub TH_row_update()
Dim cell As Range
For Each cell In Range("Time_horizon_Year")
If cell.Value >= ActiveSheet.Range("Time_Horizon") Then
cell.EntireRow.Hidden = True
ElseIf cell.Value <= ActiveSheet.Range("Time_Horizon") Then
cell.EntireRow.Hidden = False
End If
Next cell
Application.ScreenUpdating = True
End Sub
Public Sub TH_column_update()
Dim cell As Range
For Each cell In Range("comparator_range")
If cell.Value = ActiveSheet.Range("Combination_comparators") Then
cell.EntireColumn.Hidden = True
ElseIf cell.Value <= ActiveSheet.Range("Combination_comparators") Then
cell.EntireColumn.Hidden = False
End If
Next cell
Application.ScreenUpdating = True
End Sub
If you want to go trough colums and cells:
For Each col In Range("comparator_range").Columns
Debug.Print "column " & col.Address
For Each cel In col.Cells
Debug.Print " - cell " & cel.Address
Next cel
Next col
So lets say your range is A1:C5
The first for each will run for each column that exists in this range mean A B C
The second for each trough every cell inside of the colum, means A1-A5, B1-B5, C1-C5
Hope this help you already, if you need more informations just tell it.
Looking for some help with a VBA function
I have data on two sheets I need to perform an index match on.
The data size will vary every time the compare is run.
I have coded the VBA to call the data and populate both sheets but running the comparison is causing a problem.
I have created the below function, its running without error but not populating the formula in cell starting J2 to end of the J range.
Sub FormulaFill()
Dim strFormulas(1 To 1) As Variant
With ThisWorkbook.Sheets("Export Worksheet")
strFormulas(1) = "=INDEX('sheet1'!E:E,MATCH('Export Worksheet'!A2,'sheet1'!A:A,0))"
.Range("J:J").FillDown
End With
End Sub
Any help would be greatly appreciated.
W
Image after updated code applied
You were writing the formula to an array variable, not a cell, then you tried to fill the entire column by using J:J. This means it was trying to fill the entire column with the contents of cell J1, the top cell, not J2.
Here is the code with corrections.
Sub FormulaFill()
With ThisWorkbook.Sheets("Export Worksheet")
.Cells(2, 10).Formula = "=INDEX('sheet1'!E:E,MATCH('Export Worksheet'!A2,'sheet1'!A:A,0))"
.Range(.Cells(2, 10), .Cells(.Cells(.Rows.Count, 9).End(xlUp).Row, 10)).FillDown
End With
End Sub
The .Cells(.Rows.Count, 9).End(XlUp).Row determines the last filled row of column 9 (I) and the code uses that number in the range to use for the autofill of column 10 (J)
It's because you're not filling the cell with the formula.
Sub FormulaFill()
Dim strFormulas(1 To 1) As Variant
With ThisWorkbook.Sheets("Export Worksheet")
strFormulas(1) = "=INDEX('sheet1'!E:E,MATCH('Export Worksheet'!A2,'sheet1'!A:A,0))"
.Range("J1").Forumla = strFormulas(1)
.Range("J:J").FillDown
End With
End Sub
Think of my problem like this: cells FS3:FS33 show customer receipts for customers in the restaurant seats 3 to 33 ( those are the only seats ) at the present time. As they leave their receipts leave the cells FS3:FS33 and go to the bin. New customers come and go and as they come and go FS3:FS33 fills downwards to the last column ( ie there will be no gaps and they will fill from FS3 down ). Each receipt is unique and needs to be recorded and kept on the last empty row of another column on a different sheet in C:C.
This Q has been answered but I have one final problem with it not updating - see below
the combination of this sub in a module
Sub hithere3()
Dim Rng As Range
Dim Unique As Boolean
For Each Rng In Worksheets("Sheet8").Range("FS3:FS30") 'for each cell in your B1 to B30 range, sheet1
Unique = True 'we'll assume it's unique
Lastunique = Worksheets("TRADES").Range("C:C").Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
For i = 3 To Lastunique 'for each cell in the unique ID cache
If Rng.Value = Worksheets("TRADES").Cells(i, 3).Value Then 'we check if it is equal
Unique = False 'if yes, it is not unique
End If
Next
If Unique Then Worksheets("TRADES").Cells(Lastunique + 1, 3) = Rng 'adds if it is unique
Next
End Sub
with the loop check in a worksheet change events
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Intersect(Target, Range("FS3:FS33")) Is Nothing Then
'Do nothing '
Else
Call hithere3
End If
End Sub
works except it only updates when I select one of the cells in FS3:FS33
Can anyone suggest how this can be overcome?
SOLUTION
Private Sub Worksheet_calculate()
If Range("FS3:FS33") Is Nothing Then
'Do nothing'
Else
Call hithere3
End If
End Sub
Adding as an answer because comments wont let me format the code section properly. Jon am assuming you are using the code above from user3819867, all you need to do to use the intersect is change the worksheet_change module to be
Private Sub WorkSheet_Change(ByVal Target As Range)
If Intersect(Target, Range("B1:B30")) Is Nothing Then
'Do nothing '
else
Call ertdfgcvb
end if
End Sub
edited to add that I dont really see a need to call a seperate procedure here. Would put the procedure code directly in here as its quite small, plus makes it easier to read if you decide to tweak and use "target" instead
I made a simple solution for you. If your datasets are relatively small, it will take no time to run it on each value input (Worksheet_Change event).
Sub ertdfgcvb()
Dim rng As Range
Dim Unique As Boolean
For Each rng In Worksheets("Sheet1").Range("B1:B30") 'for each cell in your B1 to B30 range, sheet1
Unique = True 'we'll assume it's unique
Lastunique = Worksheets("Sheet2").Range("B:B").Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
For i = 1 To Lastunique 'for each cell in the unique ID cache
If rng.Value = Worksheets("Sheet2").Cells(i, 2).Value Then 'we check if it is equal
Unique = False 'if yes, it is not unique
End If
Next
If Unique Then Worksheets("Sheet2").Cells(Lastunique + 1, 2) = rng 'adds if it is unique
Next
End Sub
The call will look like:
Private Sub WorkSheet_Change(ByVal Target As Range)
Call ertdfgcvb
End Sub
If you have larger datasets, you will have to refer to Target instead.
So I have a loop that checks every cell in a column and finds a specific date (currently the Monday of the previous week). My code right now does select them correctly but I want it to keep the previous selection so in the end all cells of that specification are selected
Public Function LastMonday(pdat As Date) As Date
LastMonday = DateAdd("ww", -1, pdat - (Weekday(pdat, vbMonday) - 1))
End Function
Sub Macro2()
Macro2 Macro
Dim rng As Range
Dim curCellValue As String
Dim mondayStr As String
mondayStr = Format(LastMonday(Date), "dd/mm/yyyy")
Set rng = Range(ActiveSheet.Range("E2"), ActiveSheet.Range("E2").End(xlDown))
For Each Cell In rng
curCellValue = Cell.Value
If curCellValue = mondayStr Then Cell.Select
Next Cell
End Sub
As a bonus, to change the Function to a different day of last week would I simply change the vbMonday to vbTuesday etc? I admit I don't know VBA very well and most of this is just frankensteined from around here.
The best way to do that is to store all the cells in a range using the Union Method.
Also I wouldn't recommend using .Select. You may want to see THIS
Amend your code to add this code.
Dim MySel As Range
For Each cell In Rng
If cell.Value = mondayStr Then
If MySel Is Nothing Then
Set MySel = cell
Else
Set MySel = Union(MySel, cell)
End If
End If
Next cell
If Not MySel Is Nothing Then
With MySel
'.Select
'~~> Do something
End With
End If
One more thing... Please note that xlDown should be avoided as much as possible. You may want to see THIS
After I have selected a range containing numerical values, I want to, via VBA, input a =SUM formula at the bottom of each column, i.e. on the row after the last selected row. For each column it should sum all of the values in the corresponding column of the entire selection.
How can I do this?
Right now, I am using the code given by the macro recorder: ActiveCell.FormulaR1C1 = "=SUM(R[-10]C:R[-1]C)". The problem is when my range gets bigger than 10 rows it will not take the rows above the bottom 10 into consideration.
Here is a simple non-VBA Approach.
Select the cells where you want the sum and press Alt-=.
SNAPSHOT
And here is a one-line VBA code that does the same thing.
Sub AutoSum()
'~~> After you select your range
Application.CommandBars.ExecuteMso ("AutoSum")
End Sub
This works:
Sub MakeSums()
Dim source As Range
Dim iCol As Long
Dim nCol As Long
Dim nRow As Long
Set source = Selection
nCol = source.Columns.Count
nRow = source.Rows.Count
For iCol = 1 To nCol
With source.Columns(iCol).Rows(nRow).Offset(1, 0)
.FormulaR1C1 = "=SUM(R[-" & nRow & "]C:R[-1]C)"
.Font.Bold = True
End With
Next iCol
End Sub
Example:
You could also do something like this without VBA:
=SUM(OFFSET(INDIRECT(CELL("address")),1-ROW(),0,ROW()-1,1))
This will sum all cells above the cell in which the formula exists.
Here is a quick trick to sum selected cells in vba code.
Private Sub Sum_Click()
MsgBox Application.Sum(Range(Selection.Address))
End Sub
This is what I was searching for when I landed on this thread so maybe it will help someone.