I am placing a button on a sheet to allow to uppercase all items in two columns in a table.
Here is the code I have found elsewhere and adapted to try to make work:
Private Sub CommandButton1_Click()
With Range("B10", Cells(Rows.Count, "B").End(xlUp))
.Value = Evaluate("INDEX(UPPER(" & .Address(External:=True) & "),)")
End With
With Range("C10", Cells(Rows.Count, "C").End(xlUp))
.Value = Evaluate("INDEX(UPPER(" & .Address(External:=True) & "),)")
End With
End Sub
I want the Range to reference Table2, columns 1 & 2 instead of B & C.
Suggestions?
For access to all sorts of table ranges and references, you need to use a ListObject. Here's an example:
Option Explicit
Sub test()
Dim ws As Worksheet
Dim t2 As ListObject
Set ws = ActiveSheet
Set t2 = ws.ListObjects("Table2")
Debug.Print t2.ListColumns(1).Name
Dim refRange As Range
Set refRange = Union(t2.ListColumns(1).Range, t2.ListColumns(2).Range)
Debug.Print refRange.Address
End Sub
Related
I want to make the average of the entries starting at B4. Tell me what should be changed in my code. Im new to vba.
Range("F13").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "=AVERAGE(Range(Range("B4").End(xlDown)))"
Edit:
And how does it work in this case?
Range("F17").Select
Application.CutCopyMode = False
Range("F17").Formula = "=IF(COUNT(R[-13]C[-2]:R[-10]C[-2])=0,10^99,COUNT(" & Range(Range("D4"), Range("D4").End(xlDown)).Address & ")"
If your goal is to have the actual formula in the cell (so it will automatically update if the values on the worksheet change) then you could do it like:
Sub test()
Dim rgStart As Range, rgStop As Range, rg As Range
Set rgStart = Range("B4")
Set rgStop = rgStart.End(xlDown)
Set rg = Range(rgStart, rgStop)
Range("F13").Formula = "=AVERAGE(" & rg.Address & ")"
End Sub
...that is the tidier way to do it (more code but easier to understand).
This is the same code but more "compact":
Sub test()
Range("F13").Formula = "=AVERAGE(" & Range(Range("B4"), Range("B4").End(xlDown)).Address & ")"
End Sub
If you don't actually want the formula in the cell (so it's a static value) you can still call the worksheet AVERAGE function with Application.WorksheetFunction, like:
Sub test()
Dim rgStart As Range, rgStop As Range, rg As Range
Set rgStart = Range("B4")
Set rgStop = rgStart.End(xlDown)
Set rg = Range(rgStart, rgStop)
Range("F13") = Application.WorksheetFunction.Average(rg)
End Sub
...and again, "compacted":
Sub test()
Range("F13") = Application.WorksheetFunction.Average(Range(Range("B4"), Range("B4").End(xlDown)))
End Sub
I recently split my code into two sections to stop the date automatically being entered, as on a Monday, we need to do 3 days worth of data
All I did was Add a new sub and redefine the variables - now i can't delete a named range
My code:
Option Explicit
Sub Import()
Dim ws As Worksheet, lastRowC As Long
Set ws = Worksheets("Report")
lastRowC = ws.Cells(ws.Rows.Count, 3).End(xlUp).Row + 1 ' bottom populated cell of Column "C", plus 1
With ws.QueryTables.Add(Connection:= _
"TEXT;N:\Operations\001 Daily Management\Cemex\FMSQRY.CSV", Destination:= _
ws.Cells(lastRowC, 3))
.Name = "FMSQRY"
' etc
' etc
.Refresh BackgroundQuery:=False
End With
With ActiveWorkbook
.Connections("FMSQRY").Delete
.Names("FMSQRY").Delete
End With
End Sub
Sub TodaysDate()
Dim ws As Worksheet, lastRowC As Long, lastRowH As Long
Set ws = Worksheets("Report")
lastRowH = ws.Cells(ws.Rows.Count, 8).End(xlUp).Row + 1 ' bottom populated cell of Column "H", plus 1
lastRowC = ws.Cells(ws.Rows.Count, 3).End(xlUp).Row ' bottom populated cell of Column "C"
With ws.Range(ws.Cells(lastRowH, 8), ws.Cells(lastRowC, 8))
.FormulaR1C1 = "=TODAY()"
.Value = .Value
End With
End Sub
So nothing to do with the Named Range was actually touched
.Name = "FMSQRY" still names my range, but when .Names("FMSQRY").Delete comes around I get a 1004 Error
ANSWER:
With ActiveWorkbook
.Connections("FMSQRY").Delete
With ws
.Names("FMSQRY").Delete
End With
End With
Your Name is on sheet-level and not Workbook-level.(you could have the same name on different sheets)
so:
ActiveWorkbook.Worksheets("Report").Names("FMSQRY").Delete
I am not sure why that code doesn't work.
But if you write code like below then it works...
Dim nm As Name
For Each nm In ActiveWorkbook.Names
If nm.Name = "FMSQRY" Then nm.Delete
Next nm
Try the below code without the .connections:
Option Explicit
Sub test()
With ThisWorkbook
.Names("FMSQRY").Delete
End With
End Sub
Hi I could not find the answer to my question from searching.
I have multiple worksheets and would like to create a column at the very beginning with a fill-down type approach of a specific string.
For example,
If worksheet name contains "Zebra" - insert a new column at the very beginning and input "Zebra's" across all cells down up until the last data point on the adjacent column.
I need to do this for four different worksheets:
Zebra
Elephant
Rhino
Snake
Here is what I have thus far, I cannot get it to work:
Sub addAnimal()
Dim ws As Worksheet
Dim N As Long
For Each ws In ActiveWorkbook.Worksheets
If ws.Name Like "zebra*" Then
Application.Goto ActiveWorkbook.Sheets(ws.Name).Cells(2, 1)
ActiveCell.EntireColumn.Insert
ActiveCell.Value = "Zebra"
Dim lastRow As Long, lastUsedRow As Long
Dim srcRange As Range, fillRange As Range
With Worksheets(ws.Name)
lastUsedRow = .Range("A" & .Rows.Count).End(xlUp).Row
lastRow = .Range("B" & .Rows.Count).End(xlUp).Row
' Fill values from A:D all the way down to lastUsedRow
Set srcRange = .Range("A" & lastUsedRow)
Set fillRange = .Range("A" & lastRow)
fillRange.Value = srcRange.Value
End With
End If
Next ws
Due to the array of animals compared to the collection of worksheet names there is going to be some repetition but a helper sub procedure can eliminate much of it.
Option Explicit
Sub addAnimalMain()
Dim w As Long, grr As Variant
grr = Array("Zebra", "Elephant", "Rhino", "Snake")
For w = 1 To ThisWorkbook.Worksheets.Count
With ThisWorkbook.Worksheets(w)
Select Case True
Case CBool(InStr(1, .Name, grr(0), vbTextCompare))
addAnimalHelper ThisWorkbook.Worksheets(w), grr(0)
Case CBool(InStr(1, .Name, grr(1), vbTextCompare))
addAnimalHelper ThisWorkbook.Worksheets(w), grr(1)
Case CBool(InStr(1, .Name, grr(2), vbTextCompare))
addAnimalHelper ThisWorkbook.Worksheets(w), grr(2)
Case CBool(InStr(1, .Name, grr(3), vbTextCompare))
addAnimalHelper ThisWorkbook.Worksheets(w), grr(3)
End Select
End With
Next w
End Sub
Sub addAnimalHelper(ws As Worksheet, grrr As Variant)
With ws
.Columns(1).EntireColumn.Insert
.Range(.Cells(1, "A"), .Cells(.Rows.Count, "B").End(xlUp).Offset(0, -1)) = grrr
End With
End Sub
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.
I get this error when I am trying to open a UserForm. What I want is to add to a combobox all the different objects (not repeated) that are present in a column.
I have been looking some solutions around there and all I can say until now is Yes, I have a combobox called "offer1"
When it gives me the error, it highlight the .FindString() method inside the loop
Private Sub UserForm_Initialize()
Dim rCell As Range
Dim i As String
Dim ws As Worksheet
Dim text As String
text = rCell.text
ws = Offers
offer1.Clear
With offer1
For Each rCell In Sheets("Offers").Range("A2", Sheets("Offers").Cells(Rows.Count, "A").End(xlUp))
If TEST.offer1.FindString(text) = -1 Then
.AddItem CStr(text)
End If
Next rCell
End With
End Sub
(If you see some silly mistakes with the names of variables as "Ofertas" or something like that is probably that I translated some variable names to english, and I jumped over a few)
Thanks a lot
Replace your code with this:
Option Explicit
Private Sub UserForm_Initialize()
Dim rCell As Range
Dim ws As Worksheet
Dim LastRow As Long
Dim strFirstCell As String
Set ws = Sheets("Offers")
With Me.offer1
.Clear
LastRow = ws.Cells(Rows.Count, "A").End(xlUp).Row
strFirstCell = ws.Cells(2, "A").Address
For Each rCell In ws.Range(strFirstCell, ws.Cells(Rows.Count, "A").End(xlUp))
If Evaluate("=SUMPRODUCT((" & strFirstCell & ":" & rCell.Address(0, 0) & "=" & rCell.Address & ")+0)") = 1 And rCell.Value <> "" Then
.AddItem rCell.Value
End If
Next rCell
End With
End Sub
This will fill your combobox with all the unique items in column A, starting at row 2, while also skipping any blanks.