Finding a range from different columns and inserting a value - vba

My current challenge is that I have a list of data that has been pulled in from another workbook in Columns A-K which all finish on the same row. I want to label the data with all the same value in Column L
The code I have is trying to find the last cell in Column A and the last cell in Column L.
I am then trying to use the range between these two rows to insert a value across the range in Column L:
Sub FillTestType(TestType As String)
Dim rng As Range
Dim wsh As Worksheet
Dim Row As Long
Dim EndCell As Long
Dim TopCell As Long
Set wsh = Worksheets("Sheet1")
wsh.Activate
EndCell = Cells(Rows.count, "A").End(x1Up).Row
TopCell = Cells(Rows.count, "L").End(x1Up).Row
rng = Range(Cells(TopCell, 12), Cells(EndCell, 12)).Value
rng = TestType
End Sub
I keep getting a runtime error - Any help would be greatly appreciated! Or if I am being stupid and there is a better way to tackle the problem please do let me know.

Something like this should work. Mainly collating the comments:
xlUp rather than x1Up (and Option Explicit to catch that yourself in future!)
+1 to TopCell so that you don't overwrite your last value in that row
Fully qualified your Range and Cell references using With and .
Cleaned up variables which aren't necessary -- e.g. for multiple future use or readability
Option Explicit
Sub FillTestType(TestType As String)
Dim EndCell As Long
Dim TopCell As Long
With Worksheets("Sheet1")
EndCell = .Cells(.Rows.Count, "A").End(xlUp).Row
TopCell = .Cells(.Rows.Count, "L").End(xlUp).Row + 1
.Range(.Cells(TopCell, 12), .Cells(EndCell, 12)).Value = TestType
End With
End Sub

Related

Copy unknown range from specific worksheet

I am trying to do a copy in VBA, as part of a bigger macro so it needs to be in VBA, of an unknown range in a specific worksheet.
I have this code that work if I am in that worksheet:
Sub Copy()
Range("O2", Range("O" & Cells(Rows.Count, "A").End(xlUp).Row)).copy
End Sub()
And I have below that works for a specific range:
Sub Test()
Worksheets("Data").Range("O2:O10").Copy
End Sub()
How can I make the second code work as unspecific.
Thanks,
You should practice to always fully qualify all your Sheet and Range objects.
The code below is a little long, but it's good practice to define and set all your objects and variables.
Code
Option Explicit
Sub Test()
Dim Sht As Worksheet
Dim LastRow As Long
' set your worksheet object
Set Sht = ThisWorkbook.Worksheets("Data")
With Sht
' get last row in column A
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
' copy dynamic range in column O
.Range("O2:O" & LastRow).Copy
End With
End Sub
The simplest & dirtiest solution is this one:
Range("O2:O" & Cells(Rows.Count, "A").End(xlUp).Row).Copy
or you can isolate the last row as a separate variable:
lastRow = Cells(Rows.Count, "A").End(xlUp).Row
Range("O2:O" & lastRow).Copy
at the end, one may decide to declare the range to be copied as a separate variable and to work with it, declaring the parent worksheet as well:
Public Sub TestMe()
Dim lastRow As Long
Dim ws As Worksheet
Dim rangeToCopy As Range
Set ws = workshetes("Sheet1")
With ws
lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
Set rangeToCopy = .Range("O2:O" & lastRow)
rangeToCopy.Copy
End With
End Sub
And going really one step further is using a dedicated function for finding the last row per worksheet (GitHub repo here):
Function lastRow(wsName As String, Optional columnToCheck As Long = 1) As Long
Dim ws As Worksheet
Set ws = Worksheets(wsName)
lastRow = ws.Cells(ws.Rows.Count, columnToCheck).End(xlUp).Row
End Function
At some point, your code will have to know the range that's going to be copied, right? You assign that to a variable and you use it.
Option Explicit
Sub Test()
Dim startRow as Long
startRow = 'your method of determining the starting row
Dim startCol as Long
startCol = 'your method of determining the starting column
Dim endRow as Long
endRow = 'your method of determining the ending row (Last used row would work just fine)
Dim endCol as Long
endCol = 'your method of determining the ending column
With Worksheets("Data")
.Range(.Cells(startRow, startCol), .Cells(endRow, endCol)).Copy
End with
End Sub
you could use a Function you pass the "seed" range to and returning a range from passed one to the last not empty cell in the same column, as follows (explanations in comments)
Function GetRange(rng As Range) As Range
With rng.Parent ' reference passed range parent worksheet
Set GetRange = .Range(rng, .Cells(.Rows.Count, rng.Column).End(xlUp)) ' return referenced sheet range from passed range to passed range column last not empty cell
End With
End Function
to be used as follows:
Sub Test()
GetRange(Worksheets("Data").Range("O2")).Copy
End Sub
you could enhance the function and have it handle a given "final" row
Function GetRange(rng As Range, Optional finalRow As Variant) As Range
With rng.Parent ' reference passed range parent worksheet
If IsMissing(finalRow) Then ' if no "final" row passed
Set GetRange = .Range(rng, .Cells(.Rows.Count, rng.Column).End(xlUp)) ' return referenced sheet range from passed range to passed range column last not empty cell
Else 'else
Set GetRange = .Range(rng, .Cells(finalRow, rng.Column)) ' return referenced sheet range from passed range to passed range column cell in give "final" row
End If
End With
to be used as follows:
Sub Test()
GetRange(Worksheets("Data").Range("O2"), 2).Copy
End Sub
having kept "final" row as optional, the function can be used with or without passing it:
Sub Test()
GetRange(Worksheets("Data").Range("O2")).Copy ' this will copy worksheet "Data" range from row 2 down to its column "O" last not empty row
GetRange(Worksheets("Data").Range("O2"), 3).Copy ' this will copy worksheet "Data" range from row 2 down to row 3
End Sub
You clearly don't enjoy using variables, so:
Worksheets("Data").Range("O2", Worksheets("Data").Range("O" & Cells(Rows.Count, "A").End(xlUp).Row)).copy
would suffice.
Generally, a more common solution would be to use intersect and CurrentRegion:
Application.intersect(Worksheets("Data").Range("O2").CurrentRegion,Worksheets("Data").Range("O2:O999999")).copy

Convert Excel formula into VBA Macro

I have the following formula in an excel worksheet that I want to make a Macro:
IF(OR(AA2=2,AA2=3,AA2=4),"00",IF(AA2=5,"0"&LEFT(Z2,1),IF(AA2=6,LEFT(Z2,2))))
I want to establish this formula for a certain range based on another column. I have multiple formulas written already that work to do this such as:
Range("B3:B" & Cells(Rows.Count, "M").End(xlUp).Row).Value = "=B2+1"
Basically I want to make the If/Or statement above work in VBA with the desired range.
Any help would be appreciated!
Just setup your function, turn on the Macro Recorder, click on the cell that contains your function, hit F2 and hit Enter. If you want to setup dynamic start and end rows, or columns, you can use the methodologies below.
Sub DynamicRange()
'Best used when only your target data is on the worksheet
'Refresh UsedRange (get rid of "Ghost" cells)
Worksheets("Sheet1").UsedRange
'Select UsedRange
Worksheets("Sheet1").UsedRange.Select
End Sub
OR
Sub DynamicRange()
'Best used when first column has value on last row and first row has a value in the last column
Dim sht As Worksheet
Dim LastRow As Long
Dim LastColumn As Long
Dim StartCell As Range
Set sht = Worksheets("Sheet1")
Set StartCell = Range("D9")
'Find Last Row and Column
LastRow = sht.Cells(sht.Rows.Count, StartCell.Column).End(xlUp).Row
LastColumn = sht.Cells(StartCell.Row, sht.Columns.Count).End(xlToLeft).Column
'Select Range
sht.Range(StartCell, sht.Cells(LastRow, LastColumn)).Select
End Sub
OR
Sub DynamicRange()
'Best used when you want to include all data stored on the spreadsheet
Dim sht As Worksheet
Dim LastRow As Long
Dim LastColumn As Long
Dim StartCell As Range
Set sht = Worksheets("Sheet1")
Set StartCell = Range("D9")
'Refresh UsedRange
Worksheets("Sheet1").UsedRange
'Find Last Row and Column
LastRow = StartCell.SpecialCells(xlCellTypeLastCell).Row
LastColumn = StartCell.SpecialCells(xlCellTypeLastCell).Column
'Select Range
sht.Range(StartCell, sht.Cells(LastRow, LastColumn)).Select
End Sub
OR
Sub DynamicRange()
'Best used when your data does not have any entirely blank rows or columns
Dim sht As Worksheet
Dim StartCell As Range
Set sht = Worksheets("Sheet1")
Set StartCell = Range("D9")
'Select Range
StartCell.CurrentRegion.Select
End Sub
OR
Sub DynamicRange()
'Best used when column length is static
Dim sht As Worksheet
Dim LastRow As Long
Dim LastColumn As Long
Dim StartCell As Range
Set sht = Worksheets("Sheet1")
Set StartCell = Range("D9")
'Refresh UsedRange
Worksheets("Sheet1").UsedRange
'Find Last Row
LastRow = sht.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
'Select Range
sht.Range("D9:M" & LastRow).Select
End Sub
You will have a dynamic range from Excel when the formula is entered via VBA as such:
Range( Cells(2,"AB"), Cells (colMVal, "AB")).Formula = "=IF(OR(AA2=2,AA2=3,AA2=4),""00"",IF(AA2=5,""0""&LEFT(Z2,1),IF(AA2=6,LEFT(Z2,2))))"
Note that the formula is entered into row 2 all the way down to the column M value to dictate the final row (colMVal). Also note the double quotes WITHIN the formula.
If anything is required to be FIXED, rather than dynamic, you would use "$", such that:
Range( Cells(2,"AB"), Cells (colMVal, "AB")).Formula = "=IF(OR(AA$2=2,AA$2=3,AA$2=4),""00"",IF(AA$2=5,""0""&LEFT(Z$2,1),IF(AA$2=6,LEFT(Z$2,2))))"
Where I have locked that ALL references verify that the row is 2, hence AA$2. As Excel fills the formula into each row of the desired range, it will dynamically assign the correct row.

Checking if there is any data entered into a range of cells using VBA in Excel

I'm trying to call a Sub (New_Row) when the first empty row (minus the last column) is filled. I'm having trouble with how to reference a range of cells in the If statement toward the end.
Sub Data_Added()
'Check if anything has been entered into the first empty row in "Data"
Dim sht As Worksheet
Dim LastRow As Long
Dim LastColumn As Long
Dim StartCell As Range
Sheets("Data").Select
Set sht = Worksheets("Data")
Set StartCell = Range("A1").End(xlDown).Select
Worksheets("Data").UsedRange
LastRow = StartCell.SpecialCells(xlCellTypeLastCell).Row
LastColumn = StartCell.SpecialCells(xlCellTypeLastCell).Column
Set InputRange = sht.Range(StartCell, sht.Cells(LastRow + 1, LastColumn - 1))
If InputRange Is Not Nothing Then
Call New_Row
End If
End Sub
I've seen people using the Application.Intersect method, but I'm not sure if an intersect makes sense for just one row of cells. Totally new to VBA, though, so I don't know. Right now I'm getting an "Invalid use of Object" error pointing at the "Nothing" in the If statement.
Dim y As Long, lastx As Long
Dim sht As Worksheet
y = 1 'Row you want to check
Set sht = ThisWorkbook.Worksheets("Sheet1")
lastx = sht.Cells(y, sht.Columns.Count).End(xlToRight).Column - 1
If WorksheetFunction.CountA(Range(Cells(y, 1), Cells(y, lastx))) <> 0 Then 'Call New_Row when the row you are checking is empty
Call New_Row
End If
Have you tried something like this?

Remove Duplicates from range without deleting data

So I essentially want to take a range from one worksheet and remove the duplicates, save that range, without duplicates, as a some object in my vba code. Then paste that range into another sheet. However, I do not want to touch any of the data in Sheet1 when removing the duplicates.
So I have something like:
Sub removeduplicates()
Dim rng As Range
Dim num As Long
With Worksheets("Sheet1")
Set rng = .Range("A2").End(xldown).RemoveDuplicates
num = rng.Row
End With
With Worksheets("Sheet4")
.UsedRange.ClearContents
.
.
.
'Need some code here to essentially paste (w/transpose) in Sheet4 Row 1 columns A to
'to Row 1 column 'num' value. So similar to:
.Range(.Cells(1,1), .Cells(1,num))
Hopefully you understand what I am going for. I probably need to use an array or something instead but I'm just stuck. And this code has probably many mistakes. Its just after a lot of playing around.
Thanks.
copy column A from Sheet1 to Sheet4
remove duplicates from Sheet4 column A
in Sheet4 copy column A to row #1
.
Sub removeduplicates()
Dim rng As Range
Dim s1 As Worksheet, s4 As Worksheet
Set s1 = Sheets("Sheet1")
Set s4 = Sheets("Sheet4")
Dim num As Long
s4.Cells.ClearContents
num = s1.Cells(Rows.Count, 1).End(xlUp).Row
s1.Range("A2:A" & num).Copy s4.Range("A2")
s4.Range("A:A").removeduplicates Columns:=1
num = s4.Cells(Rows.Count, 1).End(xlUp).Row
s4.Range("A1:A" & num).Copy
s4.Range("B1").PasteSpecial Transpose:=True
End Sub
I think Jean-Claude has a good suggestion: copy the entire range, and then do the .RemoveDuplicates on the destination worksheet.
If you must do it in memory, it is possible without even using the .RemoveDuplicates method:
Sub removeduplicates()
Dim r as Range
Dim dictValues as Object
Set dictValues = CreateObject("Scripting.Dictionary")
For each r in Worksheets("Sheet1").Range("A2").End(xldown).Cells
dictValues(r.Value) = r.Value
Next
With dictValues
Worksheets("Sheet4").Range("A1").Resize(1, .Count).Value = .Keys()
End With
NOTE in the event that there are mope than 16,384 unique values in the rng (for Excel 2007+) this will fail.

Vba macro to copy row from table if value in table meets condition

i'm trying to make a macro which:
goes through a table
looks if value in column B of that table has a certain value
if it has, copy that row to a range in an other worksheet
The result is similar to filtering the table but I want to avoid hiding any rows
I'm kinda new to vba and don't really know where to start with this, any help much appreciated.
That is exactly what you do with an advanced filter. If it's a one shot, you don't even need a macro, it is available in the Data menu.
Sheets("Sheet1").Range("A1:D17").AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=Sheets("Sheet1").Range("G1:G2"), CopyToRange:=Range("A1:D1") _
, Unique:=False
Try it like this:
Sub testIt()
Dim r As Long, endRow as Long, pasteRowIndex As Long
endRow = 10 ' of course it's best to retrieve the last used row number via a function
pasteRowIndex = 1
For r = 1 To endRow 'Loop through sheet1 and search for your criteria
If Cells(r, Columns("B").Column).Value = "YourCriteria" Then 'Found
'Copy the current row
Rows(r).Select
Selection.Copy
'Switch to the sheet where you want to paste it & paste
Sheets("Sheet2").Select
Rows(pasteRowIndex).Select
ActiveSheet.Paste
'Next time you find a match, it will be pasted in a new row
pasteRowIndex = pasteRowIndex + 1
'Switch back to your table & continue to search for your criteria
Sheets("Sheet1").Select
End If
Next r
End Sub
Selects are slow and unnescsaary. The following code will be far faster:
Sub CopyRowsAcross()
Dim i As Integer
Dim ws1 As Worksheet: Set ws1 = ThisWorkbook.Sheets("Sheet1")
Dim ws2 As Worksheet: Set ws2 = ThisWorkbook.Sheets("Sheet2")
For i = 2 To ws1.Range("B65536").End(xlUp).Row
If ws1.Cells(i, 2) = "Your Critera" Then ws1.Rows(i).Copy ws2.Rows(ws2.Cells(ws2.Rows.Count, 2).End(xlUp).Row + 1)
Next i
End Sub
you are describing a Problem, which I would try to solve with the VLOOKUP function rather than using VBA.
You should always consider a non-vba solution first.
Here are some application examples of VLOOKUP (or SVERWEIS in German, as i know it):
http://www.youtube.com/watch?v=RCLUM0UMLXo
http://office.microsoft.com/en-us/excel-help/vlookup-HP005209335.aspx
If you have to make it as a macro, you could use VLOOKUP as an application function - a quick solution with slow performance - or you will have to make a simillar function yourself.
If it has to be the latter, then there is need for more details on your specification, regarding performance questions.
You could copy any range to an array, loop through this array and check for your value, then copy this value to any other range. This is how i would solve this as a vba-function.
This would look something like that:
Public Sub CopyFilter()
Dim wks As Worksheet
Dim avarTemp() As Variant
'go through each worksheet
For Each wks In ThisWorkbook.Worksheets
avarTemp = wks.UsedRange
For i = LBound(avarTemp, 1) To UBound(avarTemp, 1)
'check in the first column in each row
If avarTemp(i, LBound(avarTemp, 2)) = "XYZ" Then
'copy cell
targetWks.Cells(1, 1) = avarTemp(i, LBound(avarTemp, 2))
End If
Next i
Next wks
End Sub
Ok, now i have something nice which could come in handy for myself:
Public Function FILTER(ByRef rng As Range, ByRef lngIndex As Long) As Variant
Dim avarTemp() As Variant
Dim avarResult() As Variant
Dim i As Long
avarTemp = rng
ReDim avarResult(0)
For i = LBound(avarTemp, 1) To UBound(avarTemp, 1)
If avarTemp(i, 1) = "active" Then
avarResult(UBound(avarResult)) = avarTemp(i, lngIndex)
'expand our result array
ReDim Preserve avarResult(UBound(avarResult) + 1)
End If
Next i
FILTER = avarResult
End Function
You can use it in your Worksheet like this =FILTER(Tabelle1!A:C;2) or with =INDEX(FILTER(Tabelle1!A:C;2);3) to specify the result row. I am sure someone could extend this to include the index functionality into FILTER or knows how to return a range like object - maybe I could too, but not today ;)