Excel VBA Dynamic Range / Loop issue - vba

I am developing a financial model for a bank and come across the below issue which I am not able to resolve in Excel VBA, and would appreciate your help.
I have built a simple macro which essentially does two things: (i) it clears contents in a given range, (ii) it populates the same range with a formula. In a very abbreviated way it looks like the following:
Sub AutoCalculateCashFlows()
Range(D208:L208).ClearContents
Range("L208").FormulaR1C1 = "=+R[-34]C-R[-34]C[-1]"
Range("L208").AutoFill Destination:=Range("E208:L208"), Type:=xlFillDefault
End Sub
My problem is that the range that should be auto populated is dependent on how many cells did the user fill in within the range of E10:L10. Users will start populating this range from right to left, but I don't know how far they will go from column L to the left. The formula that my macro auto populates needs at least two data, ie. at least L10 and K10 should be populated and if the latter is the case then the macro only needs to auto populate L208 with formula, in case J10:L10 is filled out then the macro needs to auto populate the range L208:K208 and so on to the point that in case the full D10:L10 range is filled out then E208:L208 should be populated with formula.
I have thought to resolve this issue via two routes: (i) approaching it as a dynamic range problem in which case I need a vba code to determine the previous to the last cell populated by the user in the range D10:L10 and use the column code of that cell in "Destination:=Range("E208:L208")", or (ii) run a loop which will populate range E208:L208 with formula until the cell in the previous column within range D10:L10 is filled in by the user and stop when it is not.
Hope this makes sense and thanks in advance for the help.

When you need a dynamic range in VBA, you should simply build one. This is probably the easiest method:
Sub TestMe()
Dim colRange As Long
Dim rowRange As Long
Dim rngMain As Range
rowRange = 10
With Worksheets(1)
colRange = .Cells(1, .Columns.Count).End(xlToLeft).Column
Set rngMain = .Range(.Cells(rowRange, colRange), .Cells(100, 200))
MsgBox rngMain.Address
End With
End Sub
It is dynamic, based on the last used column in row 1 of the first Worksheet.
Concerning the second used column in Row 1, one of these 3 would probably do it for you, depending on what exactly do you want:
.Cells(1, 1).End(xlToRight).End(xlToRight).Column
.Cells(1, 1).End(xlToRight).Column
.Cells(1, 1).End(xlToRight).Column + 1

Related

Excel VBA Rows.Count reference for a loop

I need to pull a range of data from a sheet where the top 16 rows will always be the same but the data below will vary. I can find the starting cell with this
Sheets("AA").Next.Select
Range("A17").Select
Selection.End(xlDown).Offset(2, 2).Select
and then I want to count the cells using (starting cell selected above) to end of cells containing data. I have tried this
Range(Selection, Range(Selection.End(xlDown)).Rows.Count
and all kinds of variations on it but cannot seem to make it work. I need to be able refer back to both the start cell and the number of rows to pull data from that cell down to the last cell using a loop (another topic I will probably ask questions on when I get that far)
Can someone help?
Your explanation as to why you are trying to do this makes it appear you are placing more work on yourself than you need to.
Let's create a couple functions.
The first function we will call nextBlankCell, which will automatically grab the last cell before an empty range. In your case, we can even use your selection to determine this - which we will do in our next function.
nextBlankCell Function
Function nextBlankCell(ByVal startRng As Range) As Range
Set nextBlankCell = startRng.End(xlDown)
End Function
Next, let's create a function that will automatically set your entire range for you. In this case, it will be the range from your current selection to the last row containing data that we get from using the above function.
getRngDownwards Function
Function getRngDownwards() As Range
Dim celStart As Range, celEnd As Range, ws As Worksheet
Set celStart = Selection
Set ws = celStart.Parent
Set celEnd = nextBlankCell(celStart)
Set getRngDownwards = ws.Range(celStart, celEnd)
End Function
In the above function, we have two ranges celStart and celEnd. celStart is simply your current selection. I always prefer to immediately set your selection to a static range if you must use Selection (most cases it’s not necessary).
celEnd is the range that will contain the last used cell in your column.
We also determine the worksheet ws by using the selection's parent object. Protip: We avoided ActiveSheet!
Now you can put it to the test:
Sub test()
' This test shows you the address of the range
MsgBox getRngDownwards.Address
' This test visually shows you the range
getRngDownwards.Select
End Sub

Copy a static range on one sheet, and paste in a dynamic range in another sheet based on a single value in a cell

I have three parts to this problem. I have a single cell with a Week number in Sheet1!A1. I have a static range in Sheet1!B1:F1 that needs to be copied. Then I need to paste the value in a dynamic range in Sheet2 offset by the week number for rows. This is part of a larger macro I am writing for a sheet I use regularly, but I seem to have those parts down. I may be either oversimplifying or oversimplifying but this is what I have currently.
Sub CopyPaste()
Sheets(1).Range("B1:F1").Copy
OffsetRange = Sheets(1).Cells(1,1).Value
Sheets(2).Cells(1+OffsetRange,1).Paste
End Sub
When I run this, it either gives me a Runtime Error 9 or Runtime Error 438.
Anyone know whats causing these errors? When I paste the range, does the cells object point towards the first cell of the copied range when I paste in at the location?
Try it as,
Option Explicit
Sub CopyPasteOffset()
Dim OffsetRange As Long
OffsetRange = Worksheets(1).Cells(1, 1).Value
Worksheets(1).Range("B1:F1").Copy _
Destination:=Worksheets(2).Cells(1 + OffsetRange, 1)
End Sub
The .Paste method is a member of Worksheet, not Range or Cells. You may have it confused with .PasteSpecial which is a member of the Range object. In any event, it is unnecessary as a destination can be applied directly to the copy command.

Find specific cells, change value of adjacent cell, value depends on location (Excel for Mac, 15.6)

this is my first post here, I know I'm articulating this poorly.
I'm trying to find cells containing a specific phrase in a column of dates. This phrase marks the beginning of a section. I then want to state the number of days elapsed from the first date in each section to other dates in the section. The values returned should show up in the adjacent column. Below is an example of the columns.
Dates and Elapsed number of days in adjacent column
I use this formula in the 2nd column:
=A15-$A$15
And then drag this down to cells in the relevant section. I'm trying to automate this process.
I found this code on this site and changed it a little bit to get this:
For Each cCell In Range("A1,A900")
cCell.Select
If ActiveCell.Value = "Phrase" Then
ActiveCell.Offset(1, 1).Value = "-"
End If
Next cCell
So my struggle is what to say in the 2nd Value field. I somehow need to get each section to subtract the first date of each section (the date right under "Phrase").
Another challenge is to copy that first adjacent cell that was changed, and then paste special into the cells below, but stopping once the next "Phrase" appears.
I'll elaborate any way I can. Thanks.
I think it's fair to say your question doesn't show much effort at solving this problem and the code snippet simply places a dash next to a "Phrase" cell. However, for a wider audience the question is interesting because it highlights the difference between automating an Excel keystroke task and writing code to process data which is then written in an Excel worksheet. Both use VBA but the former is simply a programmatic record of keystrokes and the latter is an algorithmic solution.
The telling phrase in your question is: I use this formula in the 2nd column ... and then drag this down to cells in the relevant section. I'm trying to automate this process. It would be possible to do this by using VBA to reproduce a bunch of worksheet functions but it's fiddly and could become complicated. I'll leave someone else to answer that as they'd need to spend more time on the answer than you have on the question (one of my don't do rules!).
If, on the other hand, you step away from trying to automate keystrokes and towards VBA for data processing, the problem becomes very trivial. It's a really good example of how VBA, in just a few lines, can solve problems that Excel functions might take pages to do, and probably not reliably.
So here's the code as a VBA solution. It'll need some data checking lines added to deal with blank cells, non-dates, etc. but I'll hand that task back to you:
Dim ws As Worksheet
Dim firstCell As Range
Dim lastCell As Range
Dim dataCells As Range
Dim v As Variant
Dim output() As Variant
Dim r As Long
Dim refDate As Long
'Define the range to be worked
Set ws = ThisWorkbook.Worksheets("Sheet1") 'amend as required
Set firstCell = ws.Range("A1") 'amend as required
Set lastCell = ws.Cells(ws.Rows.Count, "A").End(xlUp) 'amend as required
Set dataCells = ws.Range(firstCell, lastCell)
'Read the values and size the output array
v = dataCells.Value2 'use Value2 to avoid date format issues
ReDim output(1 To UBound(v, 1), 1 To 1)
'Loop through the values, resetting the reference date on each "Phrase"
For r = 1 To UBound(v, 1)
If v(r, 1) = "Phrase" Then
output(r, 1) = "-"
refDate = v(r + 1, 1)
Else
output(r, 1) = v(r, 1) - refDate
End If
Next
'Write output into next column
dataCells.Offset(, 1).Value = output

Intersect not working if target range gets bigger

I am relatively new to VBA and I need help with this please.
I have a private sub within a sheet and I want it to autofill formulas adjacent to a dynamic named range, if the size of the range changes.
(edit) I am pasting data from another worksheet into this one columns A-M. My dynamic range is defined as =OFFSET($A$1,1,0,COUNTA($A:$A)-1,13). The first If statement should exit the sub if there is no data in column M and I had the destination calculating the last row of column M because I want to fill the formulas in N:O so that they cover the same number of rows as column M.
This is my code and it works if the size of the range gets smaller (i.e. if I delete rows from the bottom), but not if it gets bigger and I can't work out why!
Private Sub Worksheet_Change(ByVal Target As Range)
If Me.Range("M2").Value = "" Then
MsgBox "No Data!"
Exit Sub
Else
If Intersect(Target, Me.Range("rngOracleInvoices")) Is Nothing Then
Application.EnableEvents = False
Dim Lrows As Long
Lrows = Me.Cells(Me.Rows.Count, "N").End(xlUp).Row
Me.Range(Me.Cells(3, 14), Me.Cells(Lrows, "O")).ClearContents
Me.Range("N2:O2").AutoFill Destination:=Me.Range("N2:O" & Me.Range("M" & Me.Rows.Count).End(xlUp).Row)
End If
End If
Application.EnableEvents = True
End Sub
I put the last bit into a separate macro to test if it works on its own and for some reason, when I run it, the autofill goes all the way up to row 1 and overwrites the formulas, which is weird because I use that code a lot and it's never done that before. What have I done??!!
Also, if there is a better way to do the autofill I'd appreciate if someone could let me know what it is because I just cobbled that together from bits I found on forums :)
Thanks,
Soph
In this line Me.Range("N2:O2").AutoFill Destination:=Me.Range("N2:O" & Me.Range("M" & Me.Rows.Count).End(xlUp).Row) you calculate your last row on the column M so if it is empty it'll give you 1 and autofill your formula on row 1.
So start by calculating it on the good column (my guess is O)
You can also simply define an Integer variable to test it and if it is inferior to 2, change it back to 2, 3, 4 or whatever you want.
For your dynamic range, we might need some precision.
And for the AutoFill, you could just select manually the range N2:02 and then double-click on the bottom right square (the one you drag to autofill) and it'll autofill as long as there data in adjacent cells! (give it a try ;) )

Copy the contents and formatting of a cell if a column within the row = today()

I'm currently building a small project planner in Excel that uses the current date to plot coloured blocks under a date column to depict which stage of the project we are currently at for a particular customer (see image below).
Behind each of the coloured blocks is a drop-down menu populated by a list on another sheet. My aim is to search for the current date in cell A1 ( populated using today() ) within all columns that follow the freezed panes (depicted by the black right hand border). When the current date is found, the value of in each of the coloured blocks should be copied into the corresponding cells so that as the project progresses, a line of coloured blocks are entered for each day (with the relevant text from the drop-down depicting the current stage of that block).
Currently I am using the following formula copied into all cells that follow the freeze:
=IF(F$1 = $A$1,$C2,"")
However, when the current date is changed this merely moves the copied blocks across to the relevant column without maintaining the old values from previous days.
I've also attempted this with a VLOOKUP so that I can enter it into a macro and run if from a button but the layout does not allow for a successful VLOOKUP.
The simplest solution I believe would be to have a button that allows the user to save the current state of the column with a header that matches the current date however it has been some time since I have coded in VBA and do not remember how to do this.
Any ideas? Thanks in advance.
Not sure if this is exactly what you're looking for, but here goes...
Sub ColorCode()
Dim ws As Worksheet
Dim rng As Range
Dim cel As Range
Set ws = ThisWorkbook.Sheets("SheetNameHere")
Set rng = ws.Range("F1:I1")***
For Each cel In rng
If cel.Value = ws.Range("A1").Value Then
ws.Range("C2:C8").Copy
ws.Range(Cells(2, cel.Column), Cells(8, cel.Column)).PasteSpecial Paste:=xlPasteValues
ws.Range(Cells(2, cel.Column), Cells(8, cel.Column)).PasteSpecial Paste:=xlPasteFormats
End If
Next
End Sub
If you add that to a new module, you can assign it to a command button. I haven't had a chance to test it, but it cycles through the dates in the first row to see if they match the date in A1. If they do, it copies over the values and formats from C2:C8(change if you need to) into the rows underneath that date. You may need to change some of the ranges to suit your specific worksheet.
So your requirements seem fairly straightforward to me:
you need the tracker to identify the column with today's date
you need to establish a permanent value for each day as it occurs
you need the color of today's values to be added to the cell, and stay that way even after today's date has passed.
The formula you cite in your question, if copied across all cells, will clearly just provide a value on the column for today's date, and unless you use a circular reference to let it self assess and update its value on today's date, it will not retain information when tomorrow comes.
Your idea for a button would work if you want the user to control the time of update, or you could have code that runs either when the workbook opens or when the worksheet itself is activated (placing it in the appropriate object code under either Private Sub Worksheet_Activate() or Private Sub Workbook_Activate().
I think PermaNoob has a right idea of copying the value of the column and pasting the value (rather than the formlula) into that column, but what is missing is appropriate identification of the column containing today's date and the coloring of those cells (if you don't have some method of coloring them that you did not mention). Something like this might work either attached to a button as you suggest, or to the _Activate event as I suggest. This is untested but should give you an idea of how to approach it:
Sub UpdatePlanner()
'~~>dim variables and set initial values
Dim wb As Workbook
Set wb = Workbooks("NAME or INDEX of YOUR workbook")
Dim ws As Worksheet
Set ws = wb.Worksheets("NAME or INDEX of YOUR sheet")
Dim rngHeader As Range
Set rngHeader = ws.Range("F1", ws.Range("F1").End(xlToRight))
Dim rngDate As Range
Dim rngColumn As Range
Dim rngCell As Range
'~~>loop to find the column with today's date
For Each rngDate In rngHeader
If rngDate.value = ws.Range("A1").value Then
Set rngColumn = ws.Range(rngDate.Address, _
ws.Range(rngDate.Address).Offset(65536, 0).End(xlUp)) 'this assumes
'your column may not have a value in every row
Exit For
End If
Next rngDate
'~~>copy and paste the column values and formats
With rngColumn
.Copy
.PasteSpecial Paste:=xlPasteValues
.PasteSpecial Paste:=xlPasteFormats
End With
'~~>loop to add the color formatting (since I don't see this in your formula)
For Each rngCell In rngColumn
If rngCell.value = ws.Range(Cells(rngCell.Row, 3)).value Then
rngCell.Interior.Color = _
ws.Range(Cells(rngCell.Row, 3)).Interior.Color
End If
Next rngCell
End Sub