How can I clear the column and row starting with a reference cell?
I used
For x = 1 To 20
Sheets(1).Columns(x).ClearContents
Next x
But I want to be able to clear the contents of all rows and columns starting with row A6 as a reference point. I cant use range since the data is dynamic and changes upon insertion of data. The data came from a csv
Since your question states "I want to be able to clear the contents of all rows and columns starting with row A6 as a reference point." Then here is a one liner using SpecialCells(xlLastCell)
ActiveSheet.Range("A6", ActiveCell.SpecialCells(xlLastCell)).Clear
If your range starts at A6 and is continuous with no blanks in Row 6 and no blanks in Column A, you could set the range like this:
'Create variables
Dim wb as Workbook
Dim ws as Worksheet
Dim rng as Range
'Initialize variables
set wb = ActiveWorkbook
set ws = ActiveSheet
lastrow = ws.Range("A6").End(xlDown).Row
lastcol = ws.Range("A6").End(xlToRight).Column
'Set the range
set rng = ws.Range(Cells(6,1),Cells(lastrow,lastcol))
'Clear contents
rng.ClearContents
This uses Range.Endproperty of the Range object. It's basically like clicking on A6 and hitting ctrl+right on your keyboard and then returning the range.
Note: If there are gaps in the range you won't get the correct result.
Related
I need to convert the following excel formula to VBA code:
=C10+H:H
UPDATE:
I want to take the values in column H of Worksheet1 and add them to the value in cell C10. I then want to compare that new value to a range of values in column C in Worksheet 2. I have been using the entire column because the rows that use the data in that column fluctuate.
I want to be able to look at the data a decade at a time. So at 10 years I am using Worksheet1!H20:H30. Then at 20 years I would use Worksheet1!H20:H40 and so on.
I could reasonably for VBA purposes limit the range from the entire column to Worksheet1!H20:H1000 (maybe even less, not sure just yet). The data in column H is what I need to put in an array and then need to be able to add to that data (will probably need to store result in second array) and then compare the result to an additional grouping of data on a separate worksheet (i.e. Worksheet2!C:C).
I need to calculate age based on annual incremental increases. I have my starting age stored in C10. I have the annual increments stored in column H. The way it works in excel is if I have this in cell B22 it add C10 to H22.
This formula is wrapped in a long and daunting if statement. It compares the calculated age to an age range on a different worksheet in lets say column C (i.e. Worksheet2!C:C = C10 + Worksheet1!H:H).
I need to be able to do that in VBA.
I tried in VBA
ElseIf Worsheets("Sheet2").Range("C:C") = C10 + Worsheets("Sheet1").Range("H:H")
It throw a match error.
UPDATE: FOR LOOP IN FUNCTION I TRIED TO USE
Function arrCalc_30yrMax_age_annual_incr_stnd_mbr() As Variant
'SETS THE VARIABLES
Dim wb As Workbook
Dim ws_Calculator_TL_30yrMaxTerm As Worksheet
Dim ws_LVRates As Worksheet
Dim ws_TLRates As Worksheet
Dim ws_Misc As Worksheet
Dim rngCalc_30yrMax_age_mbr As Range
Dim rngCalc_30yrMax_age_sp As Range
Dim rngCalc_30yrMax_age_annual_incr As Range
Dim arrCalc_30yrMax_age_annual_incr As Variant
Dim arrAge_Annual_Inc As Variant
Dim Row As Long
Dim Column As Long
'SETS RANGE FOR rngCalc_30yrMax_age_annual_incr RANGE
Set wb = ThisWorkbook
Set ws_Calculator_TL_30yrMaxTerm = Worksheets("Calculator_TL_30yrMaxTerm")
Set ws_LVRates = wb.Worksheets("LVRates")
Set ws_TLRates = wb.Worksheets("TLRates")
Set ws_Misc = wb.Worksheets("Misc")
Set rngCalc_30yrMax_age_annual_incr = ws_Calculator_TL_30yrMaxTerm.Range("Calc_30yrMax_age_annual_incr")
'SETS ARRAY EQUAL TO rngCalc_30yrMax_age_annual_incr
arrCalc_30yrMax_age_annual_incr = rngCalc_30yrMax_age_annual_incr
'LOOP THROUGH THE ARRAY OF WORKSHEET VALUES
For Row = 1 To UBound(arrCalc_30yrMax_age_annual_incr, 1) 'First array dimension is rows.
For Column = 1 To UBound(arrCalc_30yrMax_age_annual_incr, 1) 'Secong array dimension is columns.
arrAge_Annual_Inc = arrCalc_30yrMax_age_annual_incr + rngCalc_30yrMax_age_mbr
Next Column
Next Row
End Function
Absent data and desired results, I remain uncertain as to just what you want. Perhaps this approach will help, if my assumptions are correct. If not, I'll delete it.
I think what you are trying to do (based on your ELSEIF statement above)
examine each value in Column C
find the value in Column H that is equal to that value +10
if you find such a value, do something.
if your comparison is more complicated (eg finding an inexact match, and the values in column H are sorted, a different approach should be used)
Here is one way of doing it. (and there are a number of others, in addition to looping through all the data -- exactly which is best (fastest) depends on the circumstances.
Option Explicit
'Worsheets("Sheet2").Range("C:C") = C10 + Worsheets("Sheet1").Range("H:H")
Sub Marine()
Dim ws1 As Worksheet, ws2 As Worksheet
Dim r1 As Range, r2 As Range
Dim vToFind 'declare as a type of value ?date ?long ?double
Dim c1 As Range, c2 As Range
Set ws1 = Worksheets("sheet1")
Set ws2 = Worksheets("sheet2")
'set ranges to end at the last used cell in the columns
With ws1
Set r1 = .Range(.Cells(1, "C"), .Cells(.Rows.Count, "C").End(xlUp))
End With
With ws2
Set r2 = .Range(.Cells(1, "H"), .Cells(.Rows.Count, "H").End(xlUp))
End With
For Each c1 In r1
vToFind = c1 - Range("c10")
Set c2 = r2.Find(what:=vToFind, after:=r2(1), _
LookIn:=xlValues, searchdirection:=xlNext)
If Not c2 Is Nothing Then
'do your thing
Stop
Else
MsgBox vToFind & " not found in target"
End If
Next c1
End Sub
I am having difficulty looping through each column before looping through the next row. The number of columns is fixed (A:K) with an unknown number of rows. The goal is to find highlighted cells (no distinct color.. and I figured the best way to do this is to code "If Not No Fill") and copy that whole row to another workbook. This is what I have so far and I am stuck:
Option Explicit
Sub Approval_Flow()
Dim AppFlowWkb As Workbook, ConfigWkb As Workbook
Dim AppFlowWkst As Worksheet, ConfigWkst As Worksheet
Dim header As Range, headerend As Range
Dim row As Long, column As Long
Set AppFlowWkb = Workbooks.Open("C:\Users\clara\Documents\Templates and Scripts\Approval Flow Change Log.xlsx")
Set ConfigWkb = ThisWorkbook
Set AppFlowWkst = AppFlowWkb.Sheets("Editor")
Set ConfigWkst = ConfigWkb.Worksheets("Approval Flows")
With ConfigWkb
Set header = Range("A7").Cells
If Not header Is Nothing Then
Set headerend = header.End(xlDown).row
For row = 7 To headerend
For j = 1 To 11
'if cell is filled (If Not No Fill), copy that whole row to another workbook
End With
End Sub
I am getting an error with the Set headerend line, but I am trying to select the last row to use it in my for loop. I appreciate any help and guidance. Thanks in advance!
You should be able to adapt this to suit your workbooks, see the comments for details
Dim aCell as Range
' Use UsedRange to get the variable number of rows,
' cycle through all the cells in that range
For Each aCell In ActiveSheet.Range("A1:K" & ActiveSheet.UsedRange.Rows.Count)
' Test if fill colour is white (none)
If Not aCell.Interior.Color = RGB(255,255,255) Then
' Insert new row in target sheet (could find last row instead)
ActiveWorkbook.Sheets("ThisOtherSheet").Range("A1").EntireRow.Insert
' Paste entire row into target sheet
aCell.EntireRow.Copy Destination:=ActiveWorkbook.Sheets("ThisOtherSheet").Range("A1")
End If
Next aCell
Alternatively to find the last row, if you know the range is continuous (no blanks) then you can use End(xlDown) like you had done, and like below
For Each aCell In ActiveSheet.Range("A1:K" & ActiveSheet.Range("K1").End(xlDown))
I'd guess you don't want to copy the same row multiple times if you've already copied it. You could do this by keeping an array or string with previously copied row numbers and checking before copying again, or use Excel's unique functions to strip the list down after copying.
Hope this helps.
Aside:
You're using a With block but not taking advantage of it, you need to put a dot . before your Range objects to specify that they're in your With sheet. Like so
Dim myRange as Range
With ActiveSheet
Set myRange = .Range("A1:C10")
End With
You're mixing the types.
It looks like you just want to use the Row that the Header data ends on.
Take out the .Row there, since you're setting headerend to be a cell address, not a specific value. Then change For row = 7 To headerend to For row = 7 To headerend.Row
Or, change Dim Headerend as Range to ...as Long and just do headerEnd = header.End(xlDown).Row (don't use Set)
I have already created a VBA script that is about 160 lines long, which produces the report that you see below.
Without using cell references (because the date ranges will change each time I run this) I now need to take the users ID, name, total hours, total break, overtime 1, and overtime 2 and copy this data into sheet 2.
Any suggestions as to how I can structure a VBA script to search row B until a blank is found, when a blank is found, copy the values from column J, K, L, M on that row, and on the row above copy value C - now paste these values on sheet 2. - Continue this process until you find two consecutive blanks or the end of the data...
Even if you can suggest a different way to tackle this problem than the logic I have assumed above it would be greatly appreciated. I can share the whole code if you are interested and show you the data I began with.
Thank you in advance,
J
As discussed, here's my approach. All the details are in the code's comments so make sure you read them.
Sub GetUserNameTotals()
Dim ShTarget As Worksheet: Set ShTarget = ThisWorkbook.Sheets("Sheet1")
Dim ShPaste As Worksheet: Set ShPaste = ThisWorkbook.Sheets("Sheet2")
Dim RngTarget As Range: Set RngTarget = ShTarget.UsedRange
Dim RngTargetVisible As Range, CellRef As Range, ColRef As Range, RngNames As Range
Dim ColIDIndex As Long: ColIDIndex = Application.Match("ID", RngTarget.Rows(1), 0)
Dim LRow As Long: LRow = RngTarget.SpecialCells(xlCellTypeLastCell).Row
'Turn off AutoFilter to avoid errors.
ShTarget.AutoFilterMode = False
'Logic: Apply filter on the UserName column, selecting blanks. We then get two essential ranges.
'RngTargetVisible is the visible range of stats. ColRef is the visible first column of stats.
With RngTarget
.AutoFilter Field:=ColIDIndex, Criteria1:="=", Operator:=xlFilterValues, VisibleDropDown:=True
Set RngTargetVisible = .Range("J2:M" & LRow).SpecialCells(xlCellTypeVisible)
Set ColRef = .Range("J2:J" & LRow).SpecialCells(xlCellTypeVisible)
End With
'Logic: For each cell in the first column of stats, let's get its offset one cell above
'and 7 cells to the left. This method is not necessary. Simply assigning ColRef to Column C's
'visible cells and changing below to CellRef.Offset(-1,0) is alright. I chose this way so it's
'easier to visualize the approach. RngNames is a consolidation of the cells with ranges, which we'll
'copy first before the stats.
For Each CellRef In ColRef
If RngNames Is Nothing Then
Set RngNames = CellRef.Offset(-1, -7)
Else
Set RngNames = Union(RngNames, CellRef.Offset(-1, -7))
End If
Next CellRef
'Copy the names first, then RngTargetVisible, which are the total stats. Copying headers is up
'to you. Of course, modify as necessary.
RngNames.Copy ShPaste.Range("A1")
RngTargetVisible.Copy ShPaste.Range("B1")
End Sub
Screenshots:
Set-up:
Result:
Demo video here:
Using Filters and Visible Cells
Let us know if this helps.
I have a bit of an issue. I have a table with 2 rows and several columns in a tab. One row contains several words and the second row contains the location of where those values should be copied.
For example :
Row 1 Sheet1!$D$1 Sheet5!$F$1 Sheet6$F$1 Sheet3!$D$1
Row 2 apple peer orange sum
So for example, I would like to copy apple to tab : sheet 1 in cell D1.
Is this possible in vba ?
Thanks!!
I will show you one simple example on how to achieve what you want. You will have to amend the code to suit your needs.
The below code is an example for Sheet1!$D$1 and Apple. I am assuming that the values are stored in "Sheet2" in Cell A1 and A2. Also I am not doing any error handling. Hope you will take care of that as well.
Sub Sample()
Dim rng As Range
Dim Sh As String, Cl As String
Dim ws As Worksheet
Set ws = ThisWorkbook.Sheets("Sheet2")
With ws
Sh = Split(.Range("A1").Value, "!")(0)
Cl = Split(.Range("A1").Value, "!")(1)
Set rng = ThisWorkbook.Sheets(Sh).Range(Cl)
rng.Value = .Range("A2").Value
End With
End Sub
Could someone please help me with some VBA code.
I am trying to copy 2 ranges of cells between workbooks (both workbooks should be created beforehand as i don't want the code to create a new workbook on the fly).
Firstly I need to copy these ranges-
From 'Sheet 3' of booka.xls, Range: Cell H5 to the last row in column H with data
copy this to 'Sheet 1' of bookb.xls, starting in Cell B2 for as many cells down in the B column
Secondly I need to copy these ranges-
From 'Sheet 3' of booka.xls, Range: Cell K5 to the last row in column K with data
copy this to 'Sheet 1' of bookb.xls, starting in Cell D2 for as many cells down in the D column
Here is what I have so far:
Sub CopyDataBetweenBooks()
Dim iRow As Long
Dim wksFr As Worksheet
Dim wksTo As Worksheet
wksFr = "C:\booka.xls"
wksTo = "C:\bookb.xls"
Set wksFrom = Workbooks(wksFr).Worksheets("Sheet 3")
Set wksTo = Workbooks(wksTo).Worksheets("Sheet 1")
With wksFrom
For iRow = 1 To 100
.Range(.Cells(iRow, 8), .Cells(iRow, 9)).Copy wksTo.Cells(iRow, 8)
Next iRow
End With
End Sub
Assuming you have the reference to wksFrom and wksTo, here is what the code should be
wksFrom.Range(wksFrom.Range("H5"), wksFrom.Range("H5").End(xlDown)).Copy wksTo.Range("B2")
wksFrom.Range(wksFrom.Range("K5"), wksFrom.Range("K5").End(xlDown)).Copy wksTo.Range("D2")
Here's an example of how to do one of the columns:
Option Explicit
Sub CopyCells()
Dim wkbkorigin As Workbook
Dim wkbkdestination As Workbook
Dim originsheet As Worksheet
Dim destsheet As Worksheet
Dim lastrow As Integer
Set wkbkorigin = Workbooks.Open("booka.xlsm")
Set wkbkdestination = Workbooks.Open("bookb.xlsm")
Set originsheet = wkbkorigin.Worksheets("Sheet3")
Set destsheet = wkbkdestination.Worksheets("Sheet1")
lastrow = originsheet.Range("H5").End(xlDown).Row
originsheet.Range("H5:H" & lastrow).Copy 'I corrected the ranges, as I had the src
destsheet.Range("B2:B" & (2 + lastrow)).PasteSpecial 'and destination ranges reversed
End Sub
As you have stated in the comments, this code above will not work for ranges with spaces, so substitute in the code below for the lastrow line:
lastrow = originsheet.range("H65536").End(xlUp).Row
Now ideally, you could make this into a subroutine that took in an origin workbook name, worksheet name/number, and range, as well as a destination workbook name, worksheet name/number, and range. Then you wouldn't have to repeat some of the code.
You can use special cells like Jonsca has suggested. However, I usually just loop through the cells. I find it gives me more control over what exactly I am copying. There is a very small effect on performance. However, I feel that in the office place, making sure the data is accurate and complete is the priority. I wrote a response to a question similar to this one that can be found here:
StackOverflow - Copying Cells in VBA for Beginners
There is also a small demonstration by iDevelop on how to use special cells for the same purpose. I think that it will help you. Good luck!
Update
In response to...
good start but it doesn't copy anything after the first blank cell – trunks Jun 9 '11 at 5:08
I just wanted to add that the tutorial in the link above will address the issue brought up in your comment. Instead of using the .End(xlDown) method, loop through the cells until you reach the last row, which you retrieve using .UsedRange.Rows.Count.