Return Row Number from Current Selection (Excel VBA) - vba

I am trying to process excel data dumped from quickbooks. In order to do what I want, I need to use first non blank row in column A, which varies depending on the period reported in quickbooks.
I am using
Sub Test()
Selection.End(xlDown).Select
to find the first non blank row in column A.
Say for example I have two files, one where the first non blank cell in column A is A157. Selection.End(xlDown).Select selects A157. I then need to select C1:C157.
The other spreadsheet has the first non blank cell in column A at A122. Selection.End(xlDown).Select selects A122. I then need to select C1:C122. The row in column A found using xlDown is a variable that I then need to use to create a selection in column C.
Any help is much appreciated. Thank you!

To get last row/column in a worksheet try:
Dim ws As Worksheet
set ws = ActiveSheet
With ws
lastRow = ws.Cells.SpecialCells(xlCellTypeLastCell).Row
lastCol = ws.Cells.SpecialCells(xlCellTypeLastCell).Column
End With
To get last row/column in a range try:
Dim rg as Range
With ws
Set rg = .Range(.Cells(1, 3), .Cells(999, 3))
With rg
lastRow = .Cells.SpecialCells(xlCellTypeLastCell).Row
lastCol = .Cells.SpecialCells(xlCellTypeLastCell).Column
End With
End With
To set new range for your last row/column try:
With ws
Set rg = .Range(.Cells(firstRow, firstCol), .Cells(lastRow, lastCol))
End With
If you have more than 1 worksheet you can specify multiple sheets simply like this:
Dim ws(3) As Worksheet
set ws(0) = Worksheets("SheetName1");
set ws(1) = Worksheets("SheetName2");
'etc.

Try,
dim rng as range
set rng = range(cells(1, "C"), cells(activecell.end(xldown).row, "C"))
rng.select

Related

Formula not filling down

I am trying to fill down two before (A, and B) to the last row in column c.
however, My code only insert the formula and doesn't fill down. if I continue to execute the code it will fill one line. then if I click execute again it will fill another line.
Sub row()
Cells(Rows.Count, 1).End(xlUp).Offset(1, 1).Select
ActiveCell.Formula = "=year(today())" 'this will be inserted into the first empty cell in column B
ActiveCell.Offset(0, -1).Value = "Actual" ''this will be inserted into the first empty cell in column A
ActiveCell.FillDown
end sub
Perhaps you mean this? You need to read up on Filldown as you are not specifying a destination range.
Sub row()
With Range(Cells(1, 3), Cells(Rows.Count, 3).End(xlUp))
.Offset(, -1).Formula = "=year(today())"
.Offset(, -2).Value = "Actual"
End With
End Sub
First, take Mat's Mug's suggestion from the comments and make sure you qualify which sheet/workbook you are calling the Cells method on. Then, try the code below. I believe FillDown will only work if there is something in the cells below to replace. Otherwise the function wouldn't know where to stop if it is filling empty cells. Instead, find the last used cell in column C and then blast the value/functions you want in all of the cells in rows A and B at once.
Sub row()
Dim wb As Workbook
Dim ws as Worksheet
Dim rngA As Range
Dim rngB As Range
Dim rngC As Range
Set wb = ThisWorkbook
Set ws = wb.Worksheets("SheetNameHere") ' change this to an actual sheet name
Set rngA = ws.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
Set rngB = rngA.Offset(0,1)
Set rngC = ws.Cells(Rows.Count, 3).End(xlUp)
ws.Range(rngA,rngC.Offset(-2,0)).Value = "Actual" ''this will be inserted into ever empty cell in column A up to the last cell in Column C
ws.Range(rngB,rngC.Offset(-1,0)).Formula = "=year(today())" 'this will be inserted into every empty cell in column B up to the last cell in Column C
End Sub

Excel VBA: How to turn formulas into values for the last used column?

I am trying to turn all my formulas into values for the last used column in my sheet. (Last column changes monthly) This is my code so far:
Sub turnvalues2()
Set rng = Range(4, Columns.Count).End(xlToLeft).Column - 1
rng.Value = rng.Value
End Sub
Range(4, Columns.Count).End(xlToLeft).Column - 1 returns a number not a range. You want the Columns() at that number.
Sub turnvalues2()
Set rng = Columns(Cells(4, Columns.Count).End(xlToLeft).Column - 1)
rng.Value = rng.Value
End Sub
Also the - 1 moves it to the second to last column used, You may want to remove that to get the last column used.
Alternate version using Range.Find to get last populated column:
Sub tgr()
Dim ws As Worksheet
Dim rFound As Range
Set ws = ActiveWorkbook.ActiveSheet
Set rFound = ws.Cells.Find("*", ws.Range("A1"), xlFormulas, , xlByColumns, xlPrevious)
If Not rFound Is Nothing Then rFound.EntireColumn.Value = rFound.EntireColumn.Value
End Sub

Excel VBA copying range within filtered data and appending to end of table on another worksheet

I have a problem, but my VBA is novice and can't figure out what's going wrong with my code.
What I'm trying to achieve is:
Step 1. In Sheet 1 I have lots of data beneath the headings in cells B8:BR8
Step 2. I filter on cell BE8 for non-blanks
Step 3. I copy the filtered data beneath BE8:BN8 (excluding the headings and I don't need all of the data hence I'm just copying a subset of the full data)
Step 4. I go to Sheet 2 where I have a populated table with headings in C8:L8 that correspond exactly to the headings BE8:BN8 from Sheet 1
Step 5. I want to append this new copied set of data to the end of this table in Sheet 2
Step 6. I want to go back to Sheet 1 and delete some of the filtered data, specifically those under headings BE8,BK8:BN8
Here's my attempt which I've tried to adapt from another code:
Sub TransferData()
Dim WS1 As Worksheet, WS2 As Worksheet
Dim RngBeforeFilter As Range, RngAfterFilter As Range
Dim LCol As Long, LRow As Long
With ThisWorkbook
Set WS1 = .Sheets("Sheet1")
Set WS2 = .Sheets("Sheet2")
End With
With WS1
'Make sure no other filters are active.
.AutoFilterMode = False
'Get the correct boundaries.
LRow = .Range("BE" & .Rows.Count).End(xlUp).Row
LCol = .Range("BE8:BN8").Column
'Set the range to filter.
Set RngBeforeFilter = .Range(.Cells(1, 2), .Cells(LRow, LCol)).Offset(1)
RngBeforeFilter.Rows(8).AutoFilter Field:=56, Criteria1:="<>"
'Set the new range, but use visible cells only.
Set RngAfterFilter = .Range(.Cells(1, 7), .Cells(LRow, LCol)).SpecialCells(xlCellTypeVisible)
'Copy the visible cells from the new range.
RngAfterFilter.Copy WS2.Range("C65536").End(xlUp)
'Clear filtered data (not working)
Sheets("Sheet1").Range("B8", Range("B8").End(xlDown)).SpecialCells(xlCellTypeVisible).ClearContents
.ShowAllData
End With
End Sub
I would appreciate any help that you could provide.
Thanks
Jacque
A few problems here:
.Range("BE8:BN8").Column
probably isn't doing what you expect - it will just return the column number of BE (ie 57).
RngBeforeFilter is doing nothing - you can just use
.Rows(8).AutoFilter Field:=56, Criteria1:="<>"
You say you want to copy data in BE:BN, but you start RngAfterFilter from column A (ie .Cells(1, 7)).
WS2.Range("C65536").End(xlUp)
gives the last row used, whereas you'll want to paste into the next row down.
You're clearing column B, rather than columns BE, BK and BN.
As such, try this instead:
Sub TransferData()
Dim WS1 As Worksheet, WS2 As Worksheet
Dim RngBeforeFilter As Range, RngAfterFilter As Range
Dim BECol As Long, BNCol As Long, LRow As Long
With ThisWorkbook
Set WS1 = .Sheets("Sheet1")
Set WS2 = .Sheets("Sheet2")
End With
With WS1
'Make sure no other filters are active.
.AutoFilterMode = False
'Get the correct boundaries.
LRow = .Range("BE" & .Rows.Count).End(xlUp).Row
BECol = .Range("BE8").Column
BNCol = .Range("BN8").Column
'Set the range to filter.
.Rows(8).AutoFilter Field:=BECol - 1, Criteria1:="<>"
'Set the new range, but use visible cells only.
Set RngAfterFilter = .Range(.Cells(9, BECol), .Cells(LRow, BNCol)).SpecialCells(xlCellTypeVisible)
'Copy the visible cells from the new range.
RngAfterFilter.Copy WS2.Range("C65536").End(xlUp).Offset(1)
'Clear filtered data
.Range("BE9", Range("BE8").End(xlDown)).SpecialCells(xlCellTypeVisible).ClearContents
.Range("BK9", Range("BK8").End(xlDown)).SpecialCells(xlCellTypeVisible).ClearContents
.Range("BN9", Range("BN8").End(xlDown)).SpecialCells(xlCellTypeVisible).ClearContents
.ShowAllData
End With
End Sub

Find Column Header By Name And Select All Data Below Column Header (Excel-VBA)

I'm attempting to create a macro to do the following:
Search a spreadsheet column header by name.
Select all data from the selected column, except column header.
Take Number Stored As Text & Convert to Number.
Converting to Number to use for VLookup.
For Example:
Visual Spreadsheet Example:
I've discovered the following code online:
With ActiveSheet.UsedRange
Set c = .Find("Employee ID", LookIn:=xlValues)
If Not c Is Nothing Then
ActiveSheet.Range(c.Address).Offset(1, 0).Select
End If
End With
However, I'm still experiencing some issues.
I just stumbled upon this, for me the answer was pretty straightforward, in any case If you're dealing with a ListObject then this is the way to go:
YOURLISTOBJECT.HeaderRowRange.Cells.Find("A_VALUE").Column
It is good to avoid looping through all cells. If the data set grows the macro can become too slow. Using special cells and paste special operation of multiplying by 1 is an efficient way of accomplishing the task.
This works...
Dim SelRange As Range
Dim ColNum As Integer
Dim CWS As Worksheet, TmpWS As Worksheet
'Find the column number where the column header is
Set CWS = ActiveSheet
ColNum = Application.WorksheetFunction.Match("Employee ID", CWS.Rows(1), 0)
'Set the column range to work with
Set SelRange = CWS.Columns(ColNum)
'Add a worksheet to put '1' onto the clipboard, ensures no issues on activesheet
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set TmpWS = ThisWorkbook.Worksheets.Add
With TmpWS
.Cells(1, 1) = 1
.Cells(1, 1).Copy
End With
'Select none blank cells using special cells...much faster than looping through all cells
Set SelRange = SelRange.SpecialCells(xlCellTypeConstants, 23)
SelRange.PasteSpecial Paste:=xlPasteAll, Operation:=xlMultiply
TmpWS.Delete
CWS.Select
Application.DisplayAlerts = True
Application.ScreenUpdating = True
Try this out. Simply add all the column header names you want to find into the collection. I'm assuming you don't have more than 200 columns, if you do simply update the for i = 1 to 200 section to a larger number.
Public Sub FindAndConvert()
Dim i As Integer
Dim lastRow As Long
Dim myRng As Range
Dim mycell As Range
Dim MyColl As Collection
Dim myIterator As Variant
Set MyColl = New Collection
MyColl.Add "Some Value"
MyColl.Add "Another Value"
lastRow = ActiveSheet.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
For i = 1 To 200
For Each myIterator In MyColl
If Cells(1, i) = myIterator Then
Set myRng = Range(Cells(2, i), Cells(lastRow, i))
For Each mycell In myRng
mycell.Value = Val(mycell.Value)
Next
End If
Next
Next
End Sub
Ok, here's a brief way of achieving your goal. First, locate the column that holds the Employee IDs. Then simply set the entire Column to be formatted as Number instead of Text?
With Worksheets(1) ' Change this sheet to the one you are using if not the first sheet
Set c = .Find("Employee ID", LookIn:=xlValues)
If Not c Is Nothing Then
' The column we want is c's Column.
Columns(c.Column).NumberFormat = 0
End If
End With
Add a dim for the range that you want:
Dim MyRng, RngStart, RngEnd as Range
Then change:
ActiveSheet.Range(c.Address).Offset(1, 0).Select
to the below so that all data in that column is found.
set RngStart = ActiveSheet.Cells(1, c.column)
set RngEnd = ActiveSheet.Cells(rows.count, c.column).end(xlup)
set MyRng = ActiveSheet.Range(RngStart & ":" & RngEnd)
Now you can play about with the data. If you want to paste this somewhere which is formatted as number:
MyRng.copy
Sheets("Wherever").Range("Wherever").pastespecial xlvalues
If you want to change the format of the cells you have now found (How to format column to number format in Excel sheet?) that is whole number format, if you want decimal points then use "number" instead of "0":
MyRng.NumberFormat = "0"
or the new destination:
Sheets("Wherever").Range("Wherever").NumberFormat = "0"
General formatting which matches exactly the convert to number function:
MyRng.NumberFormat = "General"
MyRng.Value = MyRng.Value

if else statement at copying and pasting a cell value

I have the following code which will copy/paste some columns from "data" worksheet and pastes to the next empty column in to the column that i specify in the mastersheet called "KomKo".
Dim copySheet As Worksheet
Dim pasteSheet As Worksheet
Set copySheet = Worksheets("data")
Set pasteSheet = Worksheets("KoMKo")
lRow = copySheet.Cells(copySheet.Rows.Count, 1).End(xlUp).Row
With copySheet.Range("BX2:BX" & lRow)
pasteSheet.Cells(Rows.Count, "A").End(xlUp).Offset(1, 0).Resize(.Rows.Count, .Columns.Count) = .Value
End With
Now i would like to add an if condition for another column; which should say "if column U in Worksheet "data" has cell value "8636" then these values should be pasted to Column H in Worksheet "KomKo"(pastesheet); to the next row as i used the code above in the "with" part.
Else( If the value in Column H is not 8636) then it should paste the value inside this column to Column G at Worksheet "KomKo"(pastesheet) with same preferences as above again.
How can i do this ?
So, I've come up with a suggestion below using an if-then within a loop. I think it's close to what you want...
Sub try6()
Dim ws As Worksheet
Dim ws2 As Worksheet
Dim x As Range
Set ws = Worksheets("data")
Set ws2 = Worksheets("KomKo")
For Each x In ws.Range("C1:C100")
If x.Value = 8636 Then
ws2.Range("H:H").Value = ws.Cells(Rows.Count, "A").Value
ElseIf x <> 8636 Then
ws2.Range("G:G").Value = ws.Range(Rows.Count, "B").Value
End If
Next x
End Sub
Testing it, it took a while to execute. I'd say, set a dynamic range at something like A10000 and copy it directly without needing to necessarily test for whether there is a value in the range being copied.
You can also use the Select method for the purpose and copy the selection - from personal experience, I've had mixed success with it and I've seen people advise against using it here.
These are my .02, hope it helps! Cheers.