I'm trying to make a program in the Excel VBA that inserts a formula into a column of cells. This formula changes based on the contents of the cell directly to the left.
This is the code I have written so far:
Sub Formula()
Dim colvar As Integer
colvar = 1
Dim Name As String
Name = "Sample, J."
Do While colvar <= 26
colvar = colvar + 1
Name = Range("B" & colvar).Value
Range("C" & colvar).Value = "='" & Name & "'!N18"
Loop
End Sub
As you can see, I want to insert the variable Name between the formula strings, but Excel refuses to run the code, giving me a "application-defined or object-defined error."
Is there a way to fix this?
You will need some error checking in case the sheets don't actually exist in the workbook.
it looks like you are looping through column B that has a list of sheet names and want range N18 to display next to it.
Something like
Sub Button1_Click()
Dim Lstrw As Long, rng As Range, c As Range
Dim Name As String
Lstrw = Cells(Rows.Count, "B").End(xlUp).Row
Set rng = Range("B1:B" & Lstrw)
For Each c In rng.Cells
Name = c
c.Offset(, 1) = "='" & Name & "'!N18"
Next c
End Sub
Or you can just list the sheets and show N18 next to it, run this code in a Sheet named "Sheet1"
Sub GetTheSh()
Dim sh As Worksheet, ws As Worksheet
Set ws = Sheets("Sheet1")
For Each sh In Sheets
If sh.Name <> ws.Name Then
ws.Cells(ws.Rows.Count, "A").End(xlUp).Offset(1) = sh.Name
ws.Cells(ws.Rows.Count, "A").End(xlUp).Offset(0, 1) = sh.Range("N18")
End If
Next sh
End Sub
Thank you to everyone for your help! I actually found that I had just made a silly error: the line Do While colvar<=26 should have been Do While colvar<26. The cells were being filled, but the error manifested because one cell was being filled by a nonexistent object.
I did decide to use the .Formula modifier rather than .Value. Thank you to Jeeped for suggesting that.
Related
I have a worksheet named "garcat_nv" with hundreds of columns. The first row contains the names that I'd like to give to each column. How can I loop through my sheet to give each column the name given in the first cell of that column ? This is an example of the Column AJ that I'd like to name GCFRRE.
Dim GCFRRE As Range
LastRow = garcat_nv.Cells(Rows.Count, 1).End(xlUp).Row
Set GCFRRE = Range("AJ2:AJ" & LastRow)
garcat_nv.Names.Add Name:="GCFRRE", RefersTo:=GCFREE
I attempted this loop:
Dim i As Long
Dim rng As Range
LastRow = .Cells(Rows.Count, 1).End(xlUp).Row
For i = 1 To nbr_col Step 1
Set rng = Range("i2:i" & LastRow)
.Names.Add Name:=.Cells(1, i).Value, RefersTo:=rng
Next i
I get a 1004 error. How can this be solved ? Thanks.
The RefersTo parameter should be a string rather than a range - the string being the address of the range. Sample code might look something like this (but you might want to stick to your lastRow method rather than UsedRange):
Dim col As Range
For Each col In Sheet1.UsedRange.Columns
With Sheet1.Names 'or ThisWorkbook.Names for global scope.
'Remove any existing name.
On Error Resume Next
.Item(CStr(col.Cells(1))).Delete
On Error GoTo 0
'Add the new name.
.Add _
Name:=col.Cells(1).Value, _
RefersToR1C1:="=" & col.Address(ReferenceStyle:=xlR1C1)
End With
Next
I want to paste the formula into a column by searching the column using its name.
My column name is Date1.
I want to find Date1 in my sheet and paste the following formula:
IF(ISBLANK(B5),"""",IF(ISBLANK(O5)=TRUE,""Missing PSD"",TODAY()-O5))
This should be calculated until the last row of Date1 column.
Kindly share any knowledge you have on this, it'd be very helpful.
Sub FillFormula()
Set wb = ActiveWorkbook
Dim sh As Worksheet, lastRow As Long
Set sh = wb.Worksheets("Sheet1")
lastRow = sh.Range("O" & Rows.count).End(xlUp).Row 'chosen O:O column, being involved in the formula...
sh.Range("AC5:AC" & lastRow).Formula = "=IF(ISBLANK(B5),"""",IF(ISBLANK(O5)=TRUE,""Missing PSD"",TODAY()-O5))"
lastRow2 = sh.Range("R" & Rows.count).End(xlUp).Row
sh.Range("AD5:AD" & lastRow).Formula = "=IF(ISBLANK(B5),"""",IF(ISBLANK(R5)=TRUE,""Missing RSD"",TODAY()-R5))"
End Sub
This is the code I am currently using and it works properly but my columns might change so I do not want to use the column character but instead the column name to paste the data into the correct column.
Try the next code, please. It still calculates the last row based on O:O column. If the column "Date1" has already formulas to be overwritten, I can easily adapt the code to use it:
Sub FillFormulaByHeader()
Dim wb As Workbook, sh As Worksheet, lastRow As Long, celD As Range
Set wb = ActiveWorkbook
Set sh = wb.Worksheets("Sheet1")
'Find the header ("Date1"):
Set celD = sh.Range(sh.Range("A1"), sh.cells(, cells(1, Columns.count).End(xlToLeft).Column)).Find("Date1")
If celD Is Nothing Then MsgBox "Nu such header could be found...": Exit Sub
lastRow = sh.Range("O" & rows.count).End(xlUp).row 'it can be easily changed for column with Date1 header
sh.Range(sh.cells(5, celD.Column), sh.cells(lastRow, celD.Column)).Formula = _
"=IF(ISBLANK(B5),"""",IF(ISBLANK(O5)=TRUE,""Missing PSD"",TODAY()-O5))"
End Sub
For simplicity, let's assume you have Headers in Row1. We now need to find out which column our Date1 Value is in. We can do this by simply looping over the Header Range an check if the Value equals "Date1". Now we can use this information to construct the final Range.
Sub FindDate1()
Dim c As Range
Dim date1Column as integer
Dim finalRange As Range
For Each c In Range("A1:Z1")
If c.Value = "Date1" Then
date1Column = c.Column
Exit For
End If
Next c
If date1Column = 0 Then
'in case "Date1" was not found
Exit Sub
Else
Set finalRange = Range(Cells(2, date1Column), Cells(2, date1Column).End(xlDown))
For Each c In finalRange
c.Formula = "=IF(ISBLANK(B" & c.Row & "),"""",IF(ISBLANK(O" & c.Row & ")=TRUE,""Missing PSD"",TODAY()-O" & c.Row & "))"
Next c
End If
End Sub
I am interested in renaming my document's cell references to easily perform calculations in other sheets. In the below code I am trying to name cell Di to the concatenation of the text in Ci and the year. I am using the below code and getting an error:
Sub or Function Not Defined
Any ideas?
Sub Rename()
Dim ws As Worksheet
Set ws = ThisWorkbook.ActiveSheet
For i = 1 To 50
Dim rng As Range
Dim str As String
Set rng = Range("D" & i)
rng.Name = Range("C" & i) & "_" & "2019"
Next i
End Sub
I am trying to create a code that will search for a given column header and copy the contents of the column after first replacing all the blanks with a zero.
I have tried using the following code, but the second parameter for the range function at the bottom does not work when I try to use "lastrow".
lastrow is defined by the numeric last row value, but I cant seem to figure out how to combine that with the alphabetical reference that is given in dbt.address
`Sub replacezeros()
Dim dbt As Range
Dim lastrow As Range
'This is to define last row of array
Set lastrow = Range("A" & Rows.Count).End(xlUp)
Debug.Print lastrow.Row
'This is for Debit
Set dbt = Range("A1:J1").Find("Debit")
Debug.Print dbt.Address
Debug.Print dbt.Cells
'Range(dbt.Address,).SpecialCells(xlCellTypeBlanks) = 0
End Sub`
Hoping to get this to replace all zeros only in that one column that is searched to select "Debit"
Not sure if I've understood your problem - try this:
Sub replacezeros()
Dim dbt As Range
Dim lastrow As Range
'This is to define last row of array
Set lastrow = Range("A" & Rows.Count).End(xlUp)
Debug.Print lastrow.Row
'This is for Debit
Set dbt = Range("A1:J1").Find("Debit")
If Not dbt Is Nothing Then 'avoid error if Debit not found
On Error Resume Next 'avoid error if no blanks
Range(dbt.Offset(1), Cells(lastrow.Row, dbt.Column)).SpecialCells(xlCellTypeBlanks).Value = 0
On Error GoTo 0
End If
End Sub
Something like this should work... (untested though)
Sub replacezeros()
Dim dbt As Range, rData As Range, Cell As Range
Dim lastrow As Long: lastrow = Range("A" & Rows.Count).End(xlUp).Row
'This is for Debit
Set dbt = Range("A1:J1").Find("Debit")
If Not dbt Is Nothing Then
Set rData = Range(Cells(1,dbt.Column),Cells(lastrow, dbt.Column))
For Each Cell In rData.SpecialCells(xlCellTypeBlanks)
Cell.Value = 0
Next Cell
End If
End Sub
My sheet look like :
I have a function to get index of the LAST empty cell in column A:
NextRow = Range("A" & Rows.Count).End(xlUp).Row + 1
This function works to write on second array (Type2).
But now, i would like a function to get index of the FIRST empty cell in column A. So i went to this website: Select first empty cell and i tried to adapt code but it's doesn't work:
If Array= "Type1" Then
Dim ws As Worksheet
Set ws = ActiveSheet
For Each cell In ws.Columns(1).Cells
If IsEmpty(cell) = True Then NextRow = cell: Exit For 'ERROR 1004
Next cell
End If
If Array= "Type2" Then 'It s works
NextRow = Range("A" & Rows.Count).End(xlUp).Row + 1
End If
ActiveSheet.Range("A" & NextRow) = "TEST"
Could you help me to adapt my code to have NextRow = IndexOf FIRST empty cell in A ?
You could just use the same method you did to get the last one.
NextRow = Range("A1").End(xlDown).Row + 1
I do this and it' works:
If Array= "Type1" Then
Dim ws As Worksheet
Set ws = ActiveSheet
For Each cell In ws.Columns(1).Cells
If IsEmpty(cell) = True Then
NextRow = cell.Row
Exit For
MsgBox NextRow
End If
Next cell
End If
If Array= "Type2" Then 'It s works
NextRow = Range("A" & Rows.Count).End(xlUp).Row + 1
End If
ActiveSheet.Range("A" & NextRow) = "TEST"
You should look bottom up for this.
And Find is better than xlUp.
Sub FindBlank()
Dim ws As Worksheet
Dim rng1 As Range
Set ws = ActiveSheet
Set rng1 = ws.Columns(1).Find("*", ws.[a1], xlFormulas, , xlByColumns, xlPrevious)
If Not rng1 Is Nothing Then
MsgBox "Last used cell is " & rng1.Address(0, 0)
Else
MsgBox ws.Name & " row1 is completely empty", vbCritical
End If
End Sub
I took a similar approach to some of the answers, but with the goal of repeatedly looking down the column until I could guarantee that there was no more populated cells below.
I turned this into a small function that I put in a standard module:-
Public Function getFirstBlankRowNumberOnSheet(sht As Worksheet, Optional startingRef As String = "A1") As Long 'may get more than 32767 rows in a spreadsheet (but probably not!)
Dim celTop As Range
Dim celBottom As Range
On Error Resume Next
Set celTop = sht.Range(startingRef)
Do
Set celBottom = celTop.End(xlDown)
Set celTop = celBottom.Offset(1) 'This will throw an error when the bottom cell is on the last available row (1048576)
Loop Until IsEmpty(celBottom.value)
getFirstBlankRowNumberOnSheet = celTop.Row
End Function
This will throw an error if there happens to be content in the row #1048576! The particulars of this are dependent on the Excel version I suppose in terms of maximum row cont allowed.