I'm currently in the process of solving a
type mismatch error
in a macro I'm writing, and I've written a short subroutine to drill down on the specific issue. This subroutine should loop through all of Column A, entering the numbers 1-10 in rows 1-10.
Sub looptest()
Dim rRange As Range
Dim rCell As Range
Dim i As Integer
Set rRange = ThisWorkbook.Worksheets(1).Columns(1)
i = 0
For Each rCell In rRange
If i < 10 Then
i = i + 1
rCell.Value2 = i
End If
Next rCell
End Sub
Instead this fills every cell in Column A with 1. Stepping through it in debug mode shows that instead of referencing a single cell, rCell references the entire column.
I have found that if I replace
Set rRange = ThisWorkbook.Worksheets(1).Columns(1)
with
Set rRange = ThisWorkbook.Worksheets(1).Range("A1:A100")
the macro works as intended, however I'd prefer to be able to use Columns() or something similar in my production code.
Am I using the Columns() property improperly, and if so, is there a good workaround?
Begin with these changes:
Set rRange = ThisWorkbook.Worksheets(1).Columns(1).Cells
Dim i As Long
Using the .Cells lets us loop over the cells in a column rather than columns in a worksheet.
Related
I have a Named Range col_9395 it is an entire column. I want to set a range within this Named range. I want the range to start at row 3 to row 200 of same column. Whats the best way to do this?
Original working line without Named Range:
Set rngBlnk = Sheet108.Range("T3:T200").SpecialCells(xlCellTypeBlanks)
This is the code I tried with no luck:
Set rngBlnk = Range("col_9395)(3,1):Range("col_9395)(200,1).SpecialCells (xlCellTypeBlanks)
Might be wrong, but I find this the easiest one:
Private Sub Test()
Dim rngBlnk As Range
Set rngBlnk = Range("col_9395").Rows("3:200").SpecialCells(xlCellTypeBlanks)
End Sub
You can see the sort of logic with
Option Explicit
Sub test()
Dim colToUse As Long
colToUse = ThisWorkbook.Worksheets("Sheet1").Range("ol_9395").Column
With ThisWorkbook.Worksheets("Sheet1")
Debug.Print .Range(.Cells(3, colToUse), .Cells(200, colToUse)).Address
End With
End Sub
Sub t()
Dim rng As Range
Set rng = Range("col_9395") ' for easier use
Dim blnkRng As Range
Set blnkRng = Range(Cells(rng.Rows(3).Row, rng.Column), Cells(rng.Rows(200).Row, rng.Column)).SpecialCells(xlCellTypeBlanks)
blnkRng.Select
End Sub
What I did was assign your named range to a variable (just for easier referencing). Then using the Range() property, I used the 3rd and 200th row of your named range to set the range to look for blank cells.
The idea is that this will help you in the event your named range isn't simply an entire column. It will get the relative 3rd and 200th row from your named range.
Option Explicit
Public Sub TestMe()
Dim rngBlnk As Range
Dim firstCell As Range
Dim lastCell As Range
Set firstCell = [col_9395].Cells(3, 1)
Set lastCell = [col_9395].Cells(200, 1)
If WorksheetFunction.CountBlank(Range(firstCell, lastCell)) > 0 Then
Set rngBlnk = Range(firstCell, lastCell).SpecialCells(xlCellTypeBlanks)
End If
End Sub
A kind of a problem with SpecialCells and assigning to them is that if there are no cells from the specific type, it throws an error.
Thus, there is a check with WorksheetFunction.CountBlank()>0, before the setting of rngBlnk to the special cells.
I'm late to the party, I know, but maybe this will help someone. I've stumbled on a technique that I don't see presented as an option in any of the handful of "range-in-a-range" questions here.
I discovered you can ask VBA for a range of a range directly. I have formatted some data as a Table, but it could be simply a Named Range, or even an unnamed range I suppose. My code that is working looks like this:
With Workbooks(Filename)
.Worksheets(tabName).Activate
.Worksheets(tabName).Range("SummaryBand").Range("B2:R2").Copy
End With
My Table is named SummaryBand, which due to a previous step was not necessarily always in the same absolute position on the spreadsheet, but I wanted an absolute Range within SummaryBand. In this example, "B2:R2" is the absolute position within the Table, with the top left cell of the Table being A1.
I have the following count color code, which is working fine until the range contains blank cells, for which you have to go in the function line and press enter, then the change into different kind of blank cells it seems, as i spotted the errors and everytime i do the step, the vba code is working again. How can I either correct the vba code so I can step this manual enter process for some blank cells, or is there an code that does the manual process for a certain range automatically?
Public Function SumByColor(pRange1 As Range, pRange2 As Range) As Double
'Update 20140210
Application.Volatile
Dim rng As Range
Dim xTotal As Double
xTotal = 0
For Each rng In pRange1
If rng.Font.Color = pRange2.Font.Color Then
xTotal = xTotal + rng.Value
End If
Next
SumByColor = xTotal
End Function
Your function work for me. I don't know what settings do you have, but try mine modification:
Public Function SumByColor(pRange1 As Range, pRange2 As Range) As Double
'Update 20140210
Application.Volatile
Dim rng As Range
Dim rngSum As Range
For Each rng In pRange1
If rng.Font.Color = pRange2.Font.Color And IsNumeric(rng.Value) Then
If rngSum Is Nothing Then
Set rngSum = rng
Else
Set rngSum = Union(rngSum, rng)
End If
End If
Next
SumByColor = WorksheetFunction.Sum(rngSum)
End Function
There is issue however for both mine and your version. It won't recalculate if you change font color for any cell. You must click Calculate Now in Formulas menu.
I am using follow code to find maximum value in a column. I need to know absolute reference number of where that value is found. I am hoping to use that absolute reference number in FOR loop and check what is in adjacent cells of where that value is found.
rng = Application.WorksheetFunction.Max(Columns("H"))
I have tried using match but I am getting error 2042.
adrs = Application.Match(rng, Range("H:H"), 0)
Is there a way to find out where that maximum value resides?
Please note I am searching for time stamps so wrapping rng in CLNG is not an option.
Or simply this?
Dim rng As Range
Set rng = Columns("H").Find(Application.Max(Columns("H")))
If Not rng Is Nothing Then
MsgBox rng.Address(0, 0)
End If
Try this:
Dim rng As Range
Dim maxValue As Integer
'you set your area that you get mxaimum value from
Set rng = Range("H:H")
'determine the maximum value
maxValue = Application.WorksheetFunction.Max(rng)
'select cell which contains found value
'(Find returns Range objects, so you can use it as you like)
rang.Find(maxValue).Select
You need to make sure that you are using the correct references.
For example, if the code is running off Sheet1 and the data is in Sheet2 then it is possible you will get errors. Trying this as an example I got the Error 2042 for the adrs variable when the code and the data were on different WorkSheets.
Also, always remember to Option Explicit this will force you to delcare your variables.
Try the following:
Option Explicit
Sub FindMaxValueAndReturnRowNum()
Dim SomeWorkSheet As Worksheet
'Here you can change the Sheet1 to that of you data sheet name
Set SomeWorkSheet = ThisWorkbook.Sheets("Sheet1")
Dim MaxNum As Long
Dim adrs As Long
'Notice the reference to where the code needs to evaluate
'if there is no reference to a specific sheet then it will use the active sheet.
MaxNum = Application.WorksheetFunction.Max(SomeWorkSheet.Columns("H"))
'adrs will return the row number
adrs = Application.Match(MaxNum , SomeWorkSheet.Range("H:H"), 0)
End Sub
I found a UDF that calculates the values of a cell based on their color. It worked perfectly the first time that I used it. However, now when I change the color of a cell (the color dictates if the cell has been planned or executed), in the existing workbook it does not auto-update. See code below:
Function SumByColor(CellColor As Range, rRange As Range)
Application.Volatile True
Dim cSum As Long
Dim ColIndex As Integer
Dim cl As Variant
ColIndex = CellColor.Interior.ColorIndex
For Each cl In rRange
If cl.Interior.ColorIndex = ColIndex Then
cSum = WorksheetFunction.Sum(cl, cSum)
End If
Next cl
SumByColor = cSum
End Function
I have tried Application.Volitale, but no luck. F9 works to update the cells that house the function. Though, it would be better to auto-update in case I get busy, or walk away from my WS. Any ideas?
You can create a worksheet event proc that will run when a change is recognized on the sheet:
Private Sub Worksheet_Change(ByVal Target as Range)
'Call function with appropriate variables
End Sub
I'm new to Excel VBA. I am trying to use a VBA function I found online that enables the user to use goalseek on multiple cells at a time. How do I call the function in a spreadsheet and how do I point to the cells that are supposed to be associated with the variables in the function (e.g. Taddr, Aaddr, gval). Do I have to write the cell values and ranges in the code itself and just run it that way?
Maybe I should redefine the function so that it takes these variables as input, so I can write a formula like =GSeekA(Taddr,Aaddr,gval)
Option Explicit
Sub GSeekA()
Dim ARange As Range, TRange As Range, Aaddr As String, Taddr As String, NumEq As Long, i As Long, j As Long
Dim TSheet As String, ASheet As String, NumRows As Long, NumCols As Long
Dim GVal As Double, Acell As Range, TCell As Range, Orient As String
' Create the following names in the back-solver worksheet:
' Taddr - Cell with the address of the target range
' Aaddr - Cell with the address of the range to be adjusted
' gval - the "goal" value
' To reference ranges on different sheets also add:
' TSheet - Cell with the sheet name of the target range
' ASheet - Cell with the sheet name of the range to be adjusted
Aaddr = Range("aaddr").Value
Taddr = Range("taddr").Value
On Error GoTo NoSheetNames
ASheet = Range("asheet").Value
TSheet = Range("tsheet").Value
NoSheetNames:
On Error GoTo ExitSub
If ASheet = Empty Or TSheet = Empty Then
Set ARange = Range(Aaddr)
Set TRange = Range(Taddr)
Else
Set ARange = Worksheets(ASheet).Range(Aaddr)
Set TRange = Worksheets(TSheet).Range(Taddr)
End If
NumRows = ARange.Rows.Count
NumCols = ARange.Columns.Count
GVal = Range("gval").Value
For j = 1 To NumCols
For i = 1 To NumRows
TRange.Cells(i, j).GoalSeek Goal:=GVal, ChangingCell:=ARange.Cells(i, j)
Next i
Next j
ExitSub:
End Sub
GSeekA is a Subprocedure, not a Function. Subprocedures cannot be called from worksheet cells like Functions can. And you don't want to convert GSeekA into a function. Functions should be used to return values to the cell(s) from which they're called. They shouldn't (and often can't) change other things on the sheet.
You need to run GSeekA as a sub. Now the problem becomes how you get user provided information into the sub. You can use InputBox to prompt the user to enter one piece of information. If you have too many, InputBox becomes cumbersome.
You can create areas in the spreadsheet where the user must enter information, then read from that area. That's how it's set up now. It's reading cells named asheet and tsheet. As long as those named ranges are present, the code works.
Finally, you can create a UserForm that the user will fill out. That's like putting a bunch of InputBoxes on one form.
Update Here's a simple procedure that you can start with and enhance.
Public Sub GSeekA()
Dim rAdjust As Range
Dim rTarget As Range
Dim dGoal As Double
Dim i As Long
'Set these three lines to what you want
Set rAdjust = Sheet1.Range("I2:I322")
Set rTarget = Sheet1.Range("J2:J322")
dGoal = 12.1
For i = 1 To rAdjust.Count
rTarget.Cells(i).GoalSeek dGoal, rAdjust.Cells(i)
Next i
End Sub