My VBA subroutine can't seem to find a row with a matching date.
My Objective:
To find the row number of the first row in Sheet1 with a date equal to the oldest date in Sheet2
My process is:
Find the row in Sheet2 with the oldest date
Find the first row in Sheet1 with the
same date and return the row number of that row.
What Happens
When I run my sub I get is Run-time error '91' - Object variable or With block variable not set.
If I try "Msgbox FindRow Is Nothing" I get the true response.
This makes no sense, since in this system Sheet1 E6 has the same value as Sheet2 E8
MY DATA:
Sheet1 (E2 - E8):
09/10/2013
09/10/2013
14/11/2013
14/11/2013
17/11/2013
17/11/2013
20/11/2013
Sheet2 (E2 - E8):
01/12/2013
01/12/2013
27/11/2013
27/11/2013
24/11/2013
24/11/2013
20/11/2013
17/11/2013
My code so far:
Private Sub transferPostings()
Dim EarliesNewDate As Variant
Dim FirsCandidateOverlappingRow, rowCountHist, onlyNewRowsCount As Integer
Dim wsHist, wsNew As Worksheet
Dim possibleDuplicates, onlyNew, FindRow As Range
Set wsHist = Worksheets("Sheet1")
Set wsNew = Worksheets("Sheet2")
wsNew.Range("E1").End(xlDown).NumberFormat = "General"
Range(wsHist.Range("E2"), wsHist.Range("E2").End(xlDown)).NumberFormat = "General"
EarliesNewDate = wsNew.Range("E1").End(xlDown).Value
Set FindRow = Range(wsHist.Range("E2"), wsHist.Range("E2").End(xlDown)).Find(EarliesNewDate)
wsNew.Range("E1").End(xlDown).NumberFormat = "dd/mm/yyyy"
Range(wsHist.Range("E2"), wsHist.Range("E2").End(xlDown)).NumberFormat = "dd/mm/yyyy"
MsgBox FindRow.Row
End Sub
Any help with this problem is much appreciated.
Your .Find command is not supplying any parameters. This means that it is using the parameters that were last used (or the defaults if it wasn't used in this session). At a minimum, you should be using LookIn:=xlValues and you should probably be specifying LookAt:=xlWhole.
Sub transferPostings()
Dim EarliesNewDate As Variant
Dim FirsCandidateOverlappingRow, rowCountHist, onlyNewRowsCount As Integer
Dim wsHist As Worksheet, wsNew As Worksheet
Dim possibleDuplicates, onlyNew, FindRow As Range
Set wsHist = Worksheets("Sheet1")
Set wsNew = Worksheets("Sheet2")
wsNew.Range("E1").End(xlDown).NumberFormat = "General"
Range(wsHist.Range("E2"), wsHist.Range("E2").End(xlDown)).NumberFormat = "General"
EarliesNewDate = wsNew.Range("E1").End(xlDown).Value
Set FindRow = wsHist.Range(wsHist.Range("E2"), wsHist.Range("E2").End(xlDown)).Find(What:=EarliesNewDate, LookIn:=xlValues, LookAt:=xlWhole)
wsNew.Range("E1").End(xlDown).NumberFormat = "dd/mm/yyyy"
Range(wsHist.Range("E2"), wsHist.Range("E2").End(xlDown)).NumberFormat = "dd/mm/yyyy"
MsgBox FindRow.Row
End Sub
You didn't mention that the dates in Sheet1!E:E were the results of formulas. I strongly suspect they are and that would have been worth mentioning.
BTW, when declared as Dim wsHist, wsNew As Worksheet, wsHist is a variant not a worksheet. It doesn't matter in this case but you should be aware of how variables are declared for future practise. see Declaring Variables or Declaring Variables for more details.
Related
Project Outline: The project I'm working on consists of a file with 2 sheets. The first sheet is a Dashboard of Reports with inputs about who worked it, what department it was for, and the timeframe of each report. This information is then transferred to a second sheet via a Button.
Right now the button copies the data from Dashboard to Data, adding the new information, starting in the first blank row (counted up from the bottom) of Column B. It then requests a Date input for that data from the user.
What I want to happen next:
I need to find the Range based on where the last input from Column A is, to where the last input of Column B is.
Example: Say there is Data from A1:A345. Say there is also Data from B1:B764. I need the VBA script to pull the range A346:A764 so I can then tell it to apply the Date from the input box in Column A for that range. (The dates may be historical and/or out of order so the input from the user is important. )
I'm currently using :
sh2.Cells(Rows.Count, 1).End(xlUp) - to Find the range of Column A
sh2.Cells(Rows.Count, 2).End(xlUp) - to Find the range of Column B
I'm having trouble figuring out a way to compare on range to the other in order to return the correct range for the data.
I've attempted using:
DO UNTIL (Excel crashed, it seems to loop continuously and I'm having trouble finding a way to get it to recognize when to stop)
DO UNTIL Attempt
`sh2.Cells(Rows.Count, 1).End(xlUp)(2).Select
Do Until IsEmpty(ActiveCell.Offset(, 1))
sh2.Cells(Rows.Count, 1).End(xlUp)(2).Value = myDate
Loop`
LOOP UNTIL (Excel crashed, same as above)
FOR EACH with IF NOT (I can't quite figure out how to compare the ranges to return a usable value)
FOR EACH Attempt
`Dim AColLR As Long
Dim BColLR As Long
Dim rngA As Range
Dim rngB As Range
Dim rngC As Range
Dim cell As Range
AColLR = sh2.Cells(Rows.Count, 1).End(xlUp).Row
BColLR = sh2.Cells(Rows.Count, 2).End(xlUp).Row
'Set rngB = sh2.Range("B2:B" & BColLR)
Set rngC = sh2.Range(BColLR - AColLR)
For Each cell In rngC
If Not IsEmpty(cell.Value) Then
cell.Offset(, -1).Value = myDate
End If
Next cell`
FUNCTION (I wasn't able to figure out how to call the function in the Sub, also Function might be broken?)
FUNCTION Attempt
`Function SetDifference(rngA As Range, rngB As Range) As Range
Dim sh1 As Worksheet, sh2 As Worksheet
Set sh1 = Sheets("Dashboard")
Set sh2 = Sheets("Data")
AColLR = sh2.Cells(Rows.Count, 1).End(xlUp).Row
BColLR = sh2.Cells(Rows.Count, 2).End(xlUp).Row
rngA = sh2.Range("A2:A" & AColLR)
rngB = sh2.Range("B2:B" & BColLR)
On Error Resume Next
If Intersect(rngA, rngB) Is Nothing Then
'if there is no common area then we will set both areas as result
Set SetDifference = Nothing
'alternatively
'set SetDifference = Nothing
Exit Function
End If
On Error GoTo 0
Dim aCell As Range
For Each aCell In rngA
Dim Result As Range
If Application.Intersect(aCell, rngB) Is
Nothing Then
If Result Is Nothing Then
Set Result = aCell
Else
Set Result = Union(Result, aCell)
End If
End If
Next aCell
Set SetDifference = Result
End Function`
I'm not sure which method is actually the correct one to use for this type of referencing.
Any assistance would be most appreciated!!
Something like this should work:
Dim cA As Range, cB As Range, ws As Worksheet, rng As Range
Set ws = ActiveSheet 'or some specific sheet
With ws
Set cA = .Cells(.Rows.Count, "A").End(xlUp).Offset(1)
Set cB = .Cells(.Rows.Count, "B").End(xlUp).Offset(0, -1)
Set rng = .Range(cA, cB)
End With
rng.Value = "dateHere"
I have a large sheet of data:
Updated Data
where i need to copy only a speacific part of this data to another worksheet:
The data i need to copy is always 4 cells wide however can be at any row and column. The first column cell at the top will allways be the same text value and i need to copy then from that found cell, 4 cells across to the right and then down to the cells are empty. All subsequent ranges after the first will use the same columns have several empty cells bother above and below each range needed. The macro will be run using a "button" so doesn't need to be checking the value of the cell all the time. The images are simplified versions of the data but are very accurate. 0 is used to show data surrounding range, HELLO is the data inside the range and INT_EXT_DOOR is my searched for cell value which can be in any column between data sets but will be the same inside each data set. The first range always starts at row 2.
Each range has to be numbered, defined by another worksheets cell value. For example, if my cell value is 1 i need it to copy range 1, if my value is 2 copy range 2 ect.
I have been trying to no luck to get anything that works like needed and would appreciate any help, thanks.
Test the next function, please:
Private Function testReturnBlock(strBlock As String, blkNo As Long)
Dim sh As Worksheet, ws As Worksheet, lastRow As Long, searchC As Range
Dim rng As Range
Set sh = ActiveSheet ' use here your sheet to be processed
Set ws = Worksheets("Return") 'use here your sheet where the data will be returned
Set searchC = sh.UsedRange.Find(strBlock)
If searchC Is Nothing Then MsgBox "No such a field in the worksheet...": Exit Function
lastRow = sh.Cells(Rows.Count, searchC.Column).End(xlUp).row
'The following part works well only if the blocks are separated by empty rows, as you said it is your sheet data case...
Set rng = sh.Range(searchC, sh.Cells(LastRow, searchC.Column)).SpecialCells(xlCellTypeConstants)
ws.Range("A1").Resize(rng.Areas(blkNo).Rows.Count, 4).Value = rng.Areas(blkNo).Resize(, 4).Value
End Function
The above function should be called like this:
Sub testRetBlock()
testReturnBlock "INT_EXT_DOOR", 2
End Sub
But in order to see that the correct range has been returned, you must adapt them in a way (in your test sheet), do differentiate. I mean the second one to contain "HELLO1" (at least on its first row), the following "HELLO2" and so on...
Try this routine if it does what you need. otherwise it should be a good start for adding whatever you need on top.
Option Explicit
Sub CopyBlock()
Dim wb As Excel.Workbook
Dim wsSource As Excel.Worksheet
Dim wsDest As Excel.Worksheet
Dim wsSelect As Excel.Worksheet
Dim lBlockNo As Long
Dim strCellID As String
Dim lBlock As Long
Dim lRow As Long
Dim lBlockRow As Long
Dim lBlockCol As Long
Dim searchRange As Excel.Range
Dim bRange As Excel.Range
Dim cRange As Excel.Range
Set wb = ActiveWorkbook
' set the worksheet objects
Set wsSource = wb.Sheets("Source")
Set wsDest = wb.Sheets("Dest")
Set wsSelect = wb.Sheets("Select") ' here you select which block you want to copy
' Identifier String
strCellID = "INT_EXT_DOOR"
' Which block to show. We assume that the number is in cell A1, but could be anywhere else
lBlockNo = wsSelect.Range("A1")
lRow = 1
' Find block with lBlockNo
For lBlock = 1 To lBlockNo
' Search the identifier string in current row
Do
lRow = lRow + 1
Set searchRange = wsSource.Rows(lRow)
Set bRange = searchRange.Find(strCellID, LookIn:=xlValues)
Loop While (bRange Is Nothing)
Next lBlock
lBlockRow = bRange.Row
lBlockCol = bRange.Column
' Search the first with empty cell
Do
lRow = lRow + 1
Loop While wsSource.Cells(lRow, lBlockCol) <> ""
' Copy the range found into the destination sheet
Range(Cells(lBlockRow, lBlockCol), Cells(lRow - 1, lBlockCol + 3)).Copy wsDest.Range("A1")
' Note the block copied
wsDest.Cells(1, 6) = "Block No:"
wsDest.Cells(1, 8) = lBlockNo
' Clean up (not absolutely necessary, but good practice)
Set searchRange = Nothing
Set bRange = Nothing
Set cRange = Nothing
Set wsSource = Nothing
Set wsDest = Nothing
Set wsSelect = Nothing
Set wb = Nothing
End Sub
Let me know if you need more help
I'm trying to define a range by the contents of two different cells, each containing the indirect cell addresses. I'm not sure whether it's possible, but here's an example:
Cell X100 contains value $A$1
Cell Y200 contains values $C$5
Is there any way I can use Range() and cells X100 and Y200 to arrive at Range("$A$1:$C$5")?
I've tried using Cells.Address but I can't figure out the right format for the application. Any help is appreciated!
Thanks
Edit
Thank you Tom! I have another question for you. The X100 cell is actually variable in my case, and I was using the following formula to find it:
Cells.Find("ID").Offset(1,0).Address
Is there any way to incorporate this sort of formula into the Range application? Or would it be easier to define a static cell in the spreadsheet containing this formula?
Thanks a bunch
Edit 2
Here you are! I'm dimming r and x as ranges and setting them as follows:
r = Cells.Find("ID").Offset(1,0).Address
x = Cells.Find("Description of initiative").offset(1,0).end(xldown).Offset(0,cells.Find("ID").Column-cells.Find("Description of initiative").Column).address
They're convoluted I know, but I printed them out and they are returning the right cells in the $A$1 format.
Hope this clarifies! Really appreciate your help.
Do you mean
Range(Range("X100").Value2 & ":" & Range("Y200").Value2)
Rather than working with addresses, work with Range objects.
Not sure I fully understand your setup, but something like this is maybe what you're looking for.
Sub Test()
Dim ws As Worksheet
Set ws = ActiveSheet
Dim startCell As Range
Set startCell = ws.Cells.Find(What:="ID") '<--- you should specify the other parameters of Find
Dim endCell As Range
Set endCell = ws.Cells.Find(What:="Description of initiative") '<--- again, specify parameters of Find
If startCell Is Nothing Then Exit Sub '<--- Find was unsuccessful
If endCell Is Nothing Then Exit Sub '<--- Find was unsuccessful
Set startCell = startCell.Offset(1, 0)
Dim columnOffset As Long
columnOffset = startCell.Column - endCell.Column
Set endCell = endCell.Offset(1).End(xlDown)
Set endCell = endCell.Offset(, columnOffset) '<--- there's a simpler way to do this, this just gets you back to startCell.Column, but preserving your logic
Dim myRange As Range
Set myRange = ws.Range(startCell, endCell)
End Sub
Here's the simpler way to get endCell instead of the offset.
Sub Test()
Dim ws As Worksheet
Set ws = ActiveSheet
Dim startCell As Range
Set startCell = ws.Cells.Find(What:="ID") '<--- you should specify the other parameters of Find
Dim endCell As Range
Set endCell = ws.Cells.Find(What:="Description of initiative") '<--- again, specify parameters of Find
If startCell Is Nothing Then Exit Sub '<--- Find was unsuccessful
If endCell Is Nothing Then Exit Sub '<--- Find was unsuccessful
Set startCell = startCell.Offset(1, 0)
Dim lastRow As Long
lastRow = endCell.Offset(1).End(xlDown).Row
Set endCell = ws.Cells(lastRow, startCell.Column)
Dim myRange As Range
Set myRange = ws.Range(startCell, endCell)
End Sub
not a VBA pro here, but doing my best...
The goal is to create a Macro that updates a cell value in a table based on the table row variable from Application.Match function, which I am also struggling with. Here's what I have so far and where I'm lost (also commented into the code).
I can't seem to get the match function to set my TargetRw variable to the matched row in the table. As it is currently i'm getting 'Type Mismatch', but I've attempted several different configurations and received a variety of different errors.
If i can get the match to work, I'd like to be able to set the cell value of the TargetRw and table Column "Reviewed Rate" = to the value held in the 'Rate' variable. I haven't been able to find much online regarding how to reference a table range like this in order update a cell value.
Sub ReviewTracker()
Dim Acell As Variant
Dim TargetRw As Long
Dim Rate As Variant
Dim MACMtable, RCtable, TargetTable As ListObject
Dim LUTables As Worksheet
Set LUTables = ThisWorkbook.Sheets("LookupTables")
Set MACMtable = LUTables.ListObjects("MACM_Lookup")
Set RCtable = LUTables.ListObjects("RC_Lookup")
Asht = ActiveSheet.Name
Acell = ActiveCell.Value
Rate = ActiveCell.Offset(0, -3).Value
If Asht = "Rate Codes" Then
Set TargetTable = RCtable
Else
If Asht = "MACMs" Then
Set TargetTable = MACMtable
End If
End If
***''' Can't get the TargetRw variable below to work... Type Missmatch'''***
TargetRw = Application.Match(Acell, TargetTable.ListColumns(1), 0)
With TargetTable
******'''I am trying to figure out how to set the cell corresponding to the row: TargetRw & Column 6 (name: "Reviewed Rate") to the value of the variable 'Rate'******
.DataBodyRange.Cells(TargetRw, 6) = Rate.Value '''This doesn't seem to work, but hopefully illustrates the goal'''
End With
End Sub
There are 2 tables on a single worksheet (variable: 'LUTables'). One or the other would be updated depending on the activesheet at the time the Macro was initiated. Both have a column named "Reviewed Rate", which is also the 6th column in each table.
Any assistance would be very much appreciated!
TargetTable.ListColumns(1)
should be
TargetTable.ListColumns(1).DataBodyRange
A ListColumn is not the same thing as a Range
Untested:
Sub ReviewTracker()
Dim Acell As Variant, Asht As String
Dim TargetRw As Variant '***
Dim Rate As Variant
Dim TargetTable As ListObject
Dim LUTables As Worksheet
Set LUTables = ThisWorkbook.Sheets("LookupTables")
Asht = ActiveSheet.Name
Acell = ActiveCell.Value
Rate = ActiveCell.Offset(0, -3).Value
If Asht = "Rate Codes" Then
Set TargetTable = LUTables.ListObjects("RC_Lookup")
ElseIf Asht = "MACMs" Then
Set TargetTable = LUTables.ListObjects("MACM_Lookup")
End If
TargetRw = Application.Match(Acell, TargetTable.ListColumns(1).DataBodyRange, 0)
If Not IsError(TargetRw) Then
TargetTable.DataBodyRange.Cells(TargetRw, 6) = Rate '### no .Value
End If
End Sub
I want to copy all filled cells starting from C5 to column F of a different worksheet.
I referred to another post: Excel - Combine multiple columns into one column
Modified the code based on my needs.
Sub CombineColumns()
Dim Range1 As Range, iCol As Long, Range2 As Range, Check As Range, wks As Worksheets
Set Range1 = wks("T(M)").Range(Cells(5, 3), Cells(Cells(5, 3).End(xlDown).Row, Cells(5, 3).End(xlToRight).Column))
Set Check = wks("csv").Range("F1")
If IsEmpty(Check.Value) = True Then
Set Range2 = Check
Else
LastRow = wks("csv").Range("F" & Rows.Count).End(xlUp).Row
Set Range2 = wks("csv").Cells(LastRow, 6).Offset(1, 0)
End If
For iCol = 3 To Range1.Columns.Count
wks("T(M)").Range(Cells(5, iCol), Cells(Range1.Columns(iCol).Rows.Count, iCol)).Copy
wks("csv").Range2.PasteSpecial Paste:=xlPasteValuesAndNumberFormats
Next iCol
End Sub
But I kept getting the error message
"object doesn't support this method or property"
at the step of pasting. After I tried to qualify all the ranges, It says I didn't set the object variable.
Thank you so much for the help!
How about this?
Sub Transposes()
' Example just for hardcoded data
Dim inputRange As Range
Set inputRange = Sheets("Sheet1").Range("C5:F10").SpecialCells(xlCellTypeConstants)
Dim outputCell As Range
Set outputCell = Sheets("Sheet2").Range("A1")
Dim cell As Range
For Each cell In inputRange
Dim offset As Long
outputCell.offset(offset).Value = cell.Value
offset = offset + 1
Next cell
End Sub
Set the last row in ColumnF to be whatever you want, and if that changes dynamically, just use any one of the multiple techniques out there to find the last cell you need to copy/paste.