I want to clear the contents of column B from line 2 to the last filled cell. As I am working with several open workbooks at the same time I need to make sure the correct Range gets deleted.
When I use this code I'm getting the error 1004 - run time error:
Workbooks("BO_Settings.xlsm").Activate
intLastRow = _
Workbooks("BO_Settings.xlsm") _
.Worksheets(strCurrentSheet).UsedRange.Rows.Count
Workbooks("BO_Settings.xlsm") _
.Worksheets(strCurrentSheet).Range( _
Cells(2, 2) _
, Cells(intLastRow, 2) _
).ClearContents
What am I doing wrong?
You need to specify which cell you are using inside the range.
Dim wS as worksheet
Set wS = Workbooks("BO_Settings.xlsm").Worksheets(strCurrentSheet)
Range(wS.Cells(2,2), wS.Cells(intLastRow,2)).ClearContents
Related
I have several Excel files that represent Projects. Every month there is a new sheet that appears with the updated information for the current month. I need to combine them in one sheet as a summery overview.
My problem comes when from the fact that I am downloading the project files on my PC and the formula dragging information from them refers to the folder and the sheet. Let's say now we are in October and the formula is:
IFERROR('[Project (1).xlsm]Oct 17'!$E$24;" ").
However, when November comes I will need to update Oct 17 to Nov 17 which is huge manual work.
Is there a way to do that with a drop down menu related to some VBA macro? For example there is an Intro page on which you can choose from a drop down menu the certain month and all the formula paths are updated based on that.
I typically do a find replace for this - I also have a monthly job where I have this scenario. (You can restrict the search replace to highlighted cells if required).
Also, the reference to the directory should dissappear if you load the files in memory.
With the above info you could script this - I do find the search replace takes a few seconds of a multi-hour job so I haven't bothered automating. Hit F2 and select what you want to replace and paste that into the find box (e.g. ]Oct 17 and then replace with ]Nov 17
You could try the following where you run a sub to find formulas that contain a specific string stored in a variable. I am calling it FindMonth. You search and replace this string with the desired month, ReplaceMonth. Note i am including the end part of the year to the string e.g. "Nov 17". When running each month you just edit these two lines:
FindMonth = "Oct 17" 'Edit for month you want to find
ReplaceMonth = "Nov 17" 'Edit for month you want to replace with
You could associate the procedure with a command button and use inputbox prompts for the FindMonth and ReplaceMonth and assign the value input to the variables instead.
You define the area for replacement in the Set searchRange.
As i don't know what area you are searching i have used 2 functions by Ron De Bruin to find the last used row and column in the sheet variable ws (you would amend to the sheet you want to change formulas in) and said the search range is from A1 to the last used cell i.e. lastrow, lastcolumn.
Set searchRange = ws.Range(ws.Cells(1, 1), ws.Cells(LastRow(ws), LastCol(ws)))
This is to prevent looping through every cell in the sheet.
You would need to amend to which ever sheet you are actually replacing in.
Also, consider what kind of error handling you want to include in case lookup sheet is not present in lookup workbook (e.g.Dec 17 sheet missing) or workbook is not open...... I have used On Error Resume Next for now. You might choose something like On Error GoTo ErrHandler and in the ErrHandler have a CASE Err.Number 1004 ...do something........
Option Explicit
Sub ReplaceFormula()
Dim wb As Workbook
Dim ws As Worksheet
Set wb = ThisWorkbook
Set ws = wb.Worksheets("Sheet1") ' change as appropriate to your sheet name
Dim searchRange As Range
Dim cell As Range
Dim FindMonth As String
Dim ReplaceMonth As String
FindMonth = "Oct 17"
ReplaceMonth = "Nov 17"
Set searchRange = ws.Range(ws.Cells(1, 1), ws.Cells(LastRow(ws), LastCol(ws)))
Application.EnableEvents = False
On Error Resume Next 'Sheet may not be present or source workbook may not be open
For Each cell In searchRange.Cells
If InStr(1, cell.Formula, FindMonth) > 0 Then cell.Formula = Replace(cell.Formula, FindMonth, ReplaceMonth)
Next cell
On Error GoTo 0
Application.EnableEvents = True
End Sub
Function LastRow(sh As Worksheet)
On Error Resume Next
LastRow = sh.Cells.Find(What:="*", _
After:=sh.Range("A1"), _
LookAt:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
On Error GoTo 0
End Function
Function LastCol(sh As Worksheet)
On Error Resume Next
LastCol = sh.Cells.Find(What:="*", _
After:=sh.Range("A1"), _
LookAt:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Column
On Error GoTo 0
End Function
I am currently facing an issue in which my 'for each' loop is not moving onto subsequent cells for each cell in the range I have defined when I try to execute the script. The context around the data is below:
I have 3 columns of data. Column L contains employees, Column K contains managers, and column J contains VPs. Column K & J containing managers and VPs are not fully populated - therefore, I would like to use a VBA script & Index Match to populate all the cells and match employees to managers to VPs.
I have created a reference table in which I have populated all the employees to managers to directors and have named this table "Table 4". I am then using the VBA code below to try and run through each cell in column K to populate managers:
Sub FillVPs()
Dim FillRng As Range, FillRng1 As Range, cell As Range
Set FillRng = Range("J2:J2000")
Set FillRng1 = Range("K2:K2000")
For Each cell In FillRng1
If cell.Value = "" Then
ActiveCell.Formula = _
"=INDEX(Table4[[#All],[MGRS]], MATCH(L583,Table4[[#All],[EMPS]],0))"
End If
Next cell
End Sub
I feel that something is definitely wrong with the index match formula as the match cell "L583" is not moving to the next cell each time it runs through the loop; however, I am not sure how to fix it. I also do not know what else is potentially missing. The code currently executes, but it stays stuck on one cell.
Any help is greatly appreciated, and I will make sure to clarify if necessary. Thank you in advance.
The problem is that you are only setting the formula for the ActiveCell.
ActiveCell.Formula = _
"=INDEX(Table4[[#All],[MGRS]], MATCH(L583,Table4[[#All],[EMPS]],0))"
This should fix it
cell.Formula = _
"=INDEX(Table4[[#All],[MGRS]], MATCH(L583,Table4[[#All],[EMPS]],0))"
You'll probably need to adjust L583. It will not fill correctly unless you are filling across all cell.
These ranges should probably be changed so that they are dynamic.
Set FillRng = Range("J2:J2000")
Set FillRng1 = Range("K2:K2000")
You should apply the formula to all the cells in the range
Range("K2:K2000").Formula = "=INDEX(Table4[[#All],[MGRS]], MATCH(L2,Table4[[#All],[EMPS]],0))"
UPDATE: Dynamic Range
Every table in Excel should have at least one column that contain an entry for every record in the table. This column should be used to define the height of the Dynamic Range.
For instance if Column A always has entries and you want to create a Dynamic Range for Column K
lastrow = Range("A" & Rows.Count).End(xlUp).Row
Set rng1 = Range("K2:K" & lastrow)
Or
Set rng1 = Range("A2:A" & Rows.Count).End(xlUp).Offset(0, 10)
UPDATE:
Use Range.SpecialCells(xlCellTypeBlanks) to target the blank cells. You'll have to add an Error handler because SpecialCells will throw an Error if no blank cells were found.
On Error Resume Next
Set rng1 = Range("A2:A" & Rows.Count).End(xlUp).Offset(0, 10).SpecialCells(xlCellTypeBlanks)
On Error GoTo 0
If rng1 Is Nothing Then
MsgBox "There were no Blank Cels Found", vbInformation, "Action Cancelled"
Exit Sub
End If
The "L583" was not changing because you were not telling it to. The code below should change the reference as the cell address changes.
Range.Address Property
Sub FillVPs()
Dim FillRng As Range, FillRng1 As Range, cell As Range
Set FillRng = Range("J2:J2000")
Set FillRng1 = Range("K2:K2000")
For Each cell In FillRng1
If cell.Value = "" Then
cell.Formula = _
"=INDEX(Table4[[#All],[MGRS]], MATCH(" & cell.Offset(0,1).Address() & ",Table4[[#All],[EMPS]],0))"
End If
Next cell
End Sub
I am trying to copy a range of data from a Excel workbook to another workbook without the need of selecting any workbook during this process and using worksheet object names.
I want to do this because the selection process:
Windows("SourceWorksheet").Activate - Sheet("SourceSheet").Select -
Range("SourceRange").Copy - Windows("DestinationWorksheet").Activate
- Sheet("DestinationSheet").Select - Range("DestinationRange").Paste
is very slow compare with
DestinationWorkBook.DestinationSheet.Range("DestinationRange").Value =
SourceWorkBook.SourceWorkSheet.Range("SourceRange").Value
I have got this working using sheets tap names and letter ranges:
Workbooks(DestinationWorkBook).Sheets("DestinationSheet").Range("A:C").Value = _
Workbooks(SoureceWorkBook).Sheets("SourceSheet").Range("A:C").Value
And also using semi-dynamic ranges and sheets tap names:
lastRow = Cells(Workbooks(Limits_Name).Sheets("SourceSheet").Rows.Count, _
"A").End(xlUp).Row
Workbooks(DestinationWorkBook).Sheets("DestinationSheet").Range("A1:C" & lastRow).Value = _
Workbooks(SourceWorkBook).Sheets("SourceSheet").Range("A1:C" & lastRow).Value
My problems starts when I use sheets object names instead of sheets names or cells instead of ranges. In those situation is when I get that error:
Workbooks(DestinationWorkBook).shtDestinationSheet.Range("A:C").Value = _
Workbooks(SourceWorkBook).Sheets("SourceSheet").Range("A:C").Value
OR
lastRow = Cells(Workbooks(SourceWorkBook).Sheets("SourceSheet").Rows.Count, "A").End(xlUp).Row
lastCol = Cells(1, Workbooks(SourceWorkBook).Sheets("SourceSheet").Columns.Count).End(xlToLeft).Column
Workbooks(DestinationWorkBook).Sheets("DestinationSheet").Range(Cells(1, 1), Cells(lastRow, lastCol)).Value = _
Workbooks(SourceWorkBook).Sheets("SourceSheet").Range(Cells(1, 1), Cells(lastRow, lastCol)).Value
OR (this is the ideal code)
lastRow = Cells(Workbooks(SourceWorkBook).Sheets("SourceSheet").Rows.Count, "A").End(xlUp).Row
lastCol = Cells(1, Workbooks(SourceWorkBook).Sheets("SourceSheet").Columns.Count).End(xlToLeft).Column
Workbooks(DestinationWorkBook).shtDestinationSheet.Range(Cells(1, 1), Cells(lastRow, lastCol)).Value = _
Workbooks(SourceWorkBook).Sheets("SourceSheet").Range(Cells(1, 1), Cells(lastRow, lastCol)).Value
I would like to know what is the difference between using Sheets("sheetname") and the and the sheet object name which can be given under the (name) property of the worksheet object properties.
If I use Sheets("SourceSheet").Range("") I do not need to select the sheet but using sthSourceSheet.Range("") I do.
I like to use sheet object names because the VBA code still works if the sheet name is modified.
First problem (solved):
When using an object for a Worksheet this includes also the Workbook.
While the Worksheet-Object is not a child of the workbook itself inside of the syntax like Workbook.Worksheet_Object. So either use Workbook.Worksheet(Worksheet_Object.Name) or just Worksheet_Object
Second probem (solved):
There is a problem using Range(Cells(), Cells()) in a non-active workbook... Using only Cells() with no parent sometimes causes trouble cus VBA want's to use a full path. Just Cells will retun a [workbook]Sheet!Range while using with a different parent this causes an error. VBA will get a return like: Wb1.Ws1.Range(Wb2.Ws2.Range).
You can try something like:
htDestinationSheet.Range(htDestinationSheet.Cells(1, 1), htDestinationSheet.Cells(lastRow, lastCol)).Value = Workbooks(SourceWorkBook).Sheets("SourceSheet").Range(Workbooks(SourceWorkBook).Sheets("SourceSheet").Cells(1, 1), Workbooks(SourceWorkBook).Sheets("SourceSheet").Cells(lastRow, lastCol)).Value
which should work... However: i think it's better to stay with str (looks better)
I am not a programmer but have managed to cobble together great amounts of code that work on 4 pretty large projects (Yay for me!) I have tried numerous ways to find the Last Row. Some work for me some don't. I can find a few that give me the "actual" last row regardless of blanks in Column A (this is what I need). Yet I CANNOT for my life figure how to integrate that code with the way I am passing values from my array from one workbook to another. All of the code works "As Is" but I need to find a better way of searching the whole row (currently columns A:O) for the Last Row and then copying the data over. Column A maybe empty at times and to avoid the code from being overwritten, that "Last Row" needs to check the whole row. I am currently forcing a hidden cell (A7) with a "." as a forced placeholder. Any advice would be awesome.
Option Explicit
Public Sub SaveToLog15()
Dim rng As Range, aCell As Range
Dim MyAr() As Variant
Dim n As Long, i As Long
Dim LastRow As Long
Dim NextCell As Range
Dim Sheet2 As Worksheet
Set Sheet2 = ActiveSheet
Application.ScreenUpdating = False
With Sheet2
' rng are the cells you want to read into the array.
' Cell A7 (".") is a needed "Forced Place Holder" for last row _
determination
' A7 will go away once "better" LastRow can be added to this code
Set rng = Worksheets("Main").Range("A7,D22,D19,D20,J22:J24,E23,D21,J25:J27,D62,D63,G51")
' counts number of cells in MyAr
n = rng.Cells.Count
' Redimensions array for above range
ReDim MyAr(1 To n)
' Sets start cell at 1 or "A"
n = 1
' Loops through cells to add data to the array
For Each aCell In rng.Cells
MyAr(n) = aCell.Value
n = n + 1
Next aCell
End With
On Error Resume Next
' Opens "Test Log.xls"
Workbooks.Open FileName:= _
"S:\Test Folder\Test Log.xls"
' SUBROUTINE 1 "Disable Sheet Protection and Show All" REMOVED
' Finds last row on Tab "Tracking" based on Column "A"
' Last row determination DOES NOT go to next row if first _
Column is blank
' Use A7 "." to always force Data to Col A
'**********************************************************************
'THIS WORKS FINE BUT DOES NOT RECOGNIZE THE POSSIBLE BLANK IN COL A.
With Worksheets("Incoming Data")
Set NextCell = Worksheets("Incoming Data").Cells _
(Worksheets("Incoming Data").Rows.Count, "A").End(xlUp).Offset(1, 0)
End With
' I need this code replaced by the following code or integrated into
' this code snippet. I am lost on how to make that happen.
'***********************************************************************
'***********************************************************************
'THIS CODE FINDS THE "ACTUAL" LAST ROW AND THIS IS WHAT I'D LIKE TO USE
' I need to figure how to integrate this code block with the above
' Or maybe redo the whole thing.
LastRow = Cells.Find(What:="*", After:=[A1], _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious).Row
MsgBox ("The Last Row Is: " & LastRow)
' I am not using this code in the program. It's just there to show
' what I need to use because it works. I need to make this code work
'WITH the above block.
'***********************************************************************
' Sets the size of the new array and copies MyAr to it
NextCell.Resize(1, UBound(MyAr)).Value = (MyAr)
' SUBROUTINE 2 "Add borders to cells in range" REMOVED
' SUBROUTINE 3 "Re-enable Sheet Protection" REMOVED
ActiveWorkbook.Save
'ActiveWindow.Close
Application.ScreenUpdating = True
MsgBox "Your Data has been saved to the Log File: " & vbCrLf & vbCrLf _
& "'Test Log.xls'", vbInformation, "Log Save Confirmation"
End Sub
This is a common problem with "jagged" data like:
Clearly here column B has that last row. Here is one way to get that overall Last row by looping over the four candidate columns:
Sub RealLast()
Dim m As Long
m = 0
For i = 1 To 4
candidate = Cells(Rows.Count, i).End(xlUp).Row
If candidate > m Then m = candidate
Next i
MsgBox m
End Sub
:
Find works best for most situations, below is the function i use that takes sheet ref as input and returns row number as type Long
Dim lLastRow As Long
lLastRow = LastUsedRow(shName)
Private Function LastUsedRow(sh As Worksheet) As Long
LastUsedRow = sh.Cells.Find(What:="*", After:=sh.Cells.Cells(1), _
LookAt:=xlPart, LookIn:=xlFormulas, SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, MatchCase:=False).Row
End Function
The simplest thing might be to use the specialcells method, as in range.specialcells(xllastcell). This returns the cell whose row number is the last row used anywhere in the spreadsheet, and whose column is the last column used anywhere in the worksheet. (I don't think it matters what "range" you specify; the result is always the last cell on the worksheet.)
So if you have data in cells B30 and X5 and nowhere else, cells.specialcells(xllastcell) will point to cell X30 (and range("A1").specialcells(xlastcell) will also point to cell X30).
Instead of:
LastRow = Cells.Find(What:="*", After:=[A1], _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious).Row
MsgBox ("The Last Row Is: " & LastRow)
use this:
LastRow = cells.specialcells(xllastcell).row
MsgBox ("The Last Row Is: " & LastRow)
After 35 attempts this is the code that I was able to hack into my original:
' Used to determine LastRow, LastColumn, LastCell, NextCell
Dim LastRow As Long
Dim LastColumn As Integer
Dim LastCell As Range, NextCell As Range
With Worksheets("Tracking")
' Find LastRow. Works Best. 1st and last cells can be empty
If WorksheetFunction.CountA(Cells) > 0 Then
'Search for any entry, by searching backwards by Rows.
LastRow = Cells.Find(What:="*", After:=[A1], _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious).Row
'Search for any entry, by searching backwards by Columns.
LastColumn = Cells.Find(What:="*", After:=[A1], _
SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious).Column
'MsgBox "Last Cell" & vbCrLf & vbCrLf & Cells(LastRow, LastColumn).Address
'MsgBox "The Last Row is: " & vbCrLf & vbCrLf & LastRow
'MsgBox "The Last Column is: " & vbCrLf & vbCrLf & LastColumn
End If
' Number of columns based on actual size of log range NOT MyAr(n)
Set NextCell = Worksheets("Tracking").Cells(LastRow + 1, (LastColumn - 10))
End With
This finds the "Real" Last Row and column and ignores any empty cells in Column A or J which seem to affect some of the LastRow snippets. I needed to make it ROWS instead of ROW and HAD the add the Offset portion as well. (-10) puts me back to Column "A" for my sheet and now I have removed Column "A" {the forced Place Holder "."} and have "Real" data there now. YAY for the "Hacking Code Cobbler".
Glad they pay me at work to learn this stuff. :) Solved this a while back. Just now got to update this post.
Please help! I've a problem that I've been stuck with for the past day.
I need to transfer data from one sheet to another sheet in another workbook. The output row corresponds to a value in input column a, and output column corresponds to a date in input sheet column B.
I've previously dim-ed the input/out workbooks/sheets as wbin,wbout,sheetin,sheetout respectively. Could anyone help see where my problem is? The error I get is runtime error '9': subscript out of range in the copy destination line.
Windows(wbin).Activate
Sheets(sheetin).Select
iMaxRow = 5000
Dim subj1 As String
Dim subj2 As String
For iRow = 1 To iMaxRow
subj1 = Range("B" & iRow).Text
subj2 = Range("A" & iRow).Text
With Workbooks(wbin).Sheets(sheetin).Cells(iRow, 3)
'On Error Resume Next
.Copy Destination:=Workbooks(wbout).Worksheets(sheetout).Cells(WorksheetFunction.Match(subj2 & "*", _
Workbooks(wbout).Sheets(sheetin).Columns(2), 0) & _
WorksheetFunction.Match(subj1, Workbooks(wbout).Sheets(sheetin).Rows(2), 0) + 1)
End With
Next iRow
For now, i've disabled the on error resume next. Also, the input column a has 4 numbers followed by string, while the corresponding output row header only has the 4 numbers, hence I tried matching with the wildcard.
Any advice would be really appreciated!
This is the correct way to solve your problem. You need to use 'Range.Find' instead of 'WorksheetFunction.Match'.
Dim dateHeader as Range, foundCell as Range
Set dateHeader = Workbooks(wbout).Worksheets(sheetout).Rows(2)
Set foundCell = dateHeader.Find(subj1)
.Copy Intersect(foundCell.EntireColumn, Workbooks(wbout).Worksheets(sheetout).Rows(subj2))