Excel Loop Through all filled cells in row 1 - excel

I'm sure this is possible, im just not sure what the code should be. i have 2 sheets: (1)Component which has all the Component Names where an analyst got marked down on, including dates of when the call occurred, and (2)Calculator, which counts the number of times a specific component appeared in a specific week number.
ive created a code which gets the distinct Component Names from the Component Sheet, and then copies and transpose them to the Calculator sheet. all the Component Names are in Row 1 starting from Column D1 then goes to E1, F1, and so on. i want row 2 to display the count or the number of times the component(listed in row 1) appeared in a week.
The code i have only works for columns, i do not know how to make it get the non-empty values of an entire row.
'//here the code i used to transpose Distinct Components from the Component sheet to the Calculator Sheet
Public Sub GetDistinctComponents()
Application.ScreenUpdating = False
Dim lr As Long
lr = Sheets("Components Data").Cells(Rows.Count, "F").End(xlUp).Row
Sheets("Calculator").Unprotect Password:="secret"
Sheets("Components Data").Range("F1:F" & lr).AdvancedFilter Action:=xlFilterCopy, _
CopyToRange:=ActiveSheet.Range("DW1"), Unique:=True
With ThisWorkbook.Worksheets("Calculator")
.Range(.Range("DW1"), .Range("DW1").End(xlDown)).Copy
.Range("DX1").PasteSpecial xlPasteValues, Transpose:=True
.Columns("DW").EntireColumn.Delete
End With
Sheets("Calculator").Protect Password:="secret", DrawingObjects:=False
End Sub
Here's my Component sheet
And below is my Calculator sheet. as you can see, the code to transpose the distinct Components works fine. i just do not know how to get the value of Row 1 starting from DX so i can store it in a variable which i will use in counting the number of times that component appeared in a week . I'm thinking it should go like this
Component = wsCalculator.Cells(i, "D").Value
But this code only works if i want to get the Values of all cells in Column D, not the values of the cells next to D1
and here's the code i currently have
Public Sub CountComponent()
Application.ScreenUpdating = False
Sheets("Calculator").Unprotect Password:="secret"
Set wsComponentData = Sheets("Components Data")
Set wsCalculator = Sheets("Calculator")
Dim ComponentCount As Integer
'//Get the index of the last filled row based on column A
LastComponentRowIndex = wsComponentData.Cells(Rows.Count, "A").End(xlUp).Row
'//Get Range for ComponentData
Set ComponentRange = wsComponentData.Range("F2:F" & LastComponentRowIndex)
'//Get the index of the last filled row based on column C
LasttotalauditRowIndex = wsCalculator.Cells(Rows.Count, "C").End(xlUp).Row
'//Get range for Calculator
Set MyRange = wsCalculator.Range("C2:C" & LasttotalauditRowIndex)
TotalCalls = WorksheetFunction.Sum(MyRange)
'//Looping through all filled rows in the Components Data sheet
For i = 2 To wsCalculator.Cells(Rows.Count, "A").End(xlUp).Row
'//Get Component from cell in column "DW"
'Component = wsCalculator.Cells(i, "DW").Value
'//Count the # of calls that got hit in the corresponding Component
If wsCalculator.Cells(i, "DW").Value <> "" Then
ComponentCount = Application.WorksheetFunction.CountIf( _
ComponentRange, component)
wsCalculator.Cells(i, "DX").Value = ComponentCount
End If
Next
End Sub

I'll take a crack at this. I'm not 100% sure what you are doing, but I'm going to assume you will have soon calculations in cells D2, down, and to the right. Is that correct? Try this small code sample to copy from D2 (down and right) on the "Components Data" sheet, and transpose to your "Calculator" sheet.
Sub TransposeThis()
Set Rng = Sheets("Components Data").Range("D2:D7") 'Input range of all fruits
Set Rng_output = Sheets("Calculator").Range("B2") 'Output range
For i = 1 To Rng.Cells.Count
Set rng_values = Range(Rng.Cells(i).Offset(0, 1), Rng.Cells(i).End(xlToRight)) 'For each fruit taking the values to the right which need to be transposed
If rng_values.Cells.Count < 16000 Then 'To ensure that it doesnt select till the right end of the sheet
For j = 1 To rng_values.Cells.Count
Rng_output.Value = Rng.Cells(i).Value
Rng_output.Offset(0, 1).Value = rng_values.Cells(j).Value
Set Rng_output = Rng_output.Offset(1, 0) 'Shifting the output row so that next value can be printed
Next j
End If
Next i
End Sub
Before:
After:
If I got something wrong, post your feedback, and I'll adjust the code to suit your needs.

The code below is your own code, in part, which I commented, and of my own making for those parts where you seemed to have lost your way.
Public Sub CountComponent()
' Locations:-
Dim WsComp As Worksheet
Dim WsCalc As Worksheet
Dim CompRng As Range ' column A
Dim CalcRng As Range ' Calculator!D1:D?)
Dim Rt As Long ' Target row (in WsCalc)
' Helpers:-
Dim Cell As Range
Dim R As Long
Set WsComp = Sheets("Components Data")
Set WsCalc = Sheets("Calculator")
WsCalc.Unprotect Password:="secret"
Application.ScreenUpdating = False
'//Get the index of the last filled row based on column A
With WsComp
' observe the leading period in ".Rows.Count"
'LastComponentRowIndex = .Cells(.Rows.Count, "A").End(xlUp).Row
'//Get Range for ComponentData
'Set CompRng = .Range("A2:A" & LastComponentRowIndex)
' avoids the need for decalring LastComponentRowIndex
Set CompRng = .Range(.Cells(2, "A"), _
.Cells(.Rows.Count, "A").End(xlUp))
End With
With WsCalc
' set a range of all criteria to look up
Set CalcRng = .Range(.Cells(1, "D"), _
.Cells(1, .Columns.Count).End(xlToLeft))
'//Get the index of the last non-empty row in column B
' loop through all rows in WsCalc
For R = .Cells(.Rows.Count, "B").End(xlUp).Row To 2 Step -1
If Val(.Cells(R, "B").Value) Then ' presumed to be a week number
'//Loop through all audit criteria
For Each Cell In CalcRng
With .Cells(R, Cell.Column)
.Value = WorksheetFunction.CountIfs( _
CompRng, Cell.Value, _
CompRng.Offset(0, 1), WsCalc.Cells(R, "B").Value)
.NumberFormat = "0;-0;;" ' suppress display of zero
End With
Next Cell
End If
.Cells(R, "C").Value = WorksheetFunction.Sum(CalcRng.Offset(R - 1))
Next R
End With
Application.ScreenUpdating = True
End Sub
Frankly, I couldn't understand all of your intentions. I presumed that column B in your Calculations sheet would contain a week number and that this week number would also be found in the Components Data (in column B). If so, you would be counting the occurrences of each component by week, and that is what I programmed.
I think it doesn't matter if I got that part wrong. Your main question was how to look up each of the Components in Calculations!D1:??. That method is very well demonstrated in my above answer and I feel confident you will be able to transplant the useful bits to your own project. Good luck!

I suggest taking a look at VBA dictionaries. In this case, you could store each component as a key and for the value you can accumulate the number of occurrences of the component for a given week.
I don't have a VBA editor available on my computer at the moment to test this, but it would likely look something along the lines of what I've got below. Also, I'll admit that I may not have fully understood the layout of your sheets, but the general principle here will definitely apply.
For a pretty full overview of dictionaries in VBA, here's a good resource that'd I'd recommend: https://excelmacromastery.com/vba-dictionary/
Public Sub CountComponent()
Application.ScreenUpdating = False
Sheets("Calculator").Unprotect Password:="secret"
Set wsComponentData = Sheets("Components Data")
Set wsCalculator = Sheets("Calculator")
'//Get the index of the last filled row based on column A
LastComponentRowIndex = wsComponentData.Cells(Rows.Count, "A").End(xlUp).Row
'//Get Range for ComponentData
Set ComponentRange = wsComponentData.Range("A2:A" & LastComponentRowIndex)
'//Get the index of the last filled row based on column C
LasttotalauditRowIndex = wsCalculator.Cells(Rows.Count, "C").End(xlUp).Row
'//Get range for Calculator
Set MyRange = wsCalculator.Range("C2:C" & LasttotalauditRowIndex)
TotalCalls = WorksheetFunction.Sum(MyRange)
'// Declare a new dictionary
dim componentDict as New Scripting.Dictionary
'// First loop through the Calculator sheet to get each component
'// and set initial value to zero
dim i as Long, lastCalcColumn as Long
lastCalcColumn = wsCalculator.Cells(1, Columns.count).end(xlToLeft).Column
for i = 4 to lastCalcColumn
'// Adding each item to dictionary, a couple of ways to write this,
'// but this is probably the easiest
componentDict(wsCalculator.Cells(i, 1).Value) = 0
next i
'//Looping through all filled rows in the Components Data sheet
'// I changed this to loop through each row in your component sheet
'// So that we can accumulate the total occurences
dim current_key as String
For i = 2 To LastComponentRowIndex
If wsComponentData.Range("G" & i).Value <> "" Then
'// assuming component names are in the "G" column
'// change this as needed
current_key = wsComponentData.Range("G" & i).Value
componentDict(current_key) = componentDict(current_key) + 1
end if
Next i
'// now back to the Calculator sheet to enter the values
for i = 4 to lastCalcColumn
current_key = wsCalculator.Cells(i, 1).Value
wsCalculator.Cells(i, 2).Value = componentDict(current_key)
next i
End Sub

Related

VBA Add rows based on how many times a criteria is met

I am quite new to VBA so my question may sound silly to some of you.
I have a problem with my code. I am trying to check between 2 sheets(1st: test and 2nd: test data. In the code I am using the code name of the sheets) how may times a criteria/my product is met and based on that number to add that many rows beneath the SKU/product.
What I want to do is, if for my first product/SKU I have stock in 5 different locations, I want to add 5 rows in the first sheet and to see the qty in column D and the location in column E.
TestData tab
The reason why I need to list the quantity in different cells is that the stock is in different locations, so I can not just add in to one cell.
I am also adding screen shots of how my two sheets look like.
I have not add the loop to find the location yet, but I want to understand how to add the rows first.
Sub test()
Dim myrange As Range, testrange As Range, cell As Range, result As Range
Dim i As Long, testlastrow As Long, lastrow As Long
Dim helprng As Range
lastrow = TESTTAB.Range("a" & Rows.Count).End(xlUp).row
testlastrow = TDATA.Range("a" & Rows.Count).End(xlUp).row
Set testrange = TDATA.Range("a2:c" & testlastrow)
Set myrange = TESTTAB.Range("b2:b" & lastrow)
Set result = TESTTAB.Range("d2:e" & testlastrow)
Set helprng = TESTTAB.Range("f2:f" & lastrow)
For Each cell In myrange
For i = 1 To lastrow
If cell.Cells(i, 1) = testrange.Cells(i, 1) Then
result.Cells(i, 1) = testrange.Cells(i, 2)
End If
Next i
Next cell
End Sub
Here is the raw structure you were asking for.
Sub test()
' 011
Dim Rng As Range
Dim Tmp As Variant
Dim Radd As Long ' number of rows to add
Dim R As Long ' row counter
With Tdata
' Range, Cells and Rows Count, all in the same sheet
' exclude caption row(s)
Set Rng = .Range(.Cells(2, "A"), .Cells(.Rows.Count, "A").End(xlUp))
End With
Application.ScreenUpdating = False ' speed up the process
With TestTab
' end the loop in row 2 because row 1 might contain captions
' loop bottom to top because row numbers will change
' below the current row as you insert rwos
' column 1 = "A"
For R = .Cells(.Rows.Count, 1).End(xlUp).Row To 2 Step -1
Tmp = .Cells(R, 1).Value
Radd = Application.CountIf(Rng, Tmp)
If Radd > 1 Then
.Range(.Rows(R + 1), .Rows(R + Radd)).Insert
.Cells(R + 1, 1).Value = Radd ' for testing purposes
End If
Next R
End With
Application.ScreenUpdating = True ' now you look
End Sub
As our Evil Blue Monkey has suggested, inserting blank rows and then populating them may not be the most efficient way. You can copy a row and then click Insert to insert the copied data into a new row. Get the syntax from the Macro recorder if it's of interest. It works with the Range object the same way.

Match function in excel macro giving only first result

i'm new to excal macros/vba, and i am encountering a problem which i do not know how to approach.
I have a workbook that includes several sheets. There is 1 file which is more or less a master list, and 3 files which are sort of a packing list.
I have put in a command button with a macro in the 3 packing list respectively that tells me if a certain item in the packing list exist in the master, and if it does it tells me which row it appears in. This is working fine, however my problem is that if a particular items appears several times in the master list(due to different purchase date), the macro only gives the first result.
I would like to know if there are any ways such that all possible results appears instead of just the first.
below is a sample of the code i used
Private Sub CommandButton1_Click()
Dim k As Integer
For k = 3 To 1000
Cells(k, 24).Value = Application.Match(Cells(k, 2), Sheets("master").Range("B2:B1000"), 0)
Next k
End Sub
if your "master" sheet data is a list of contiguous not empty cells from B2 down to last not empty one, then here's a different approach playing around a bit with
Option Explicit
Private Sub CommandButton1_Click()
Dim cell As Range
With Worksheets("master") ' reference your "master" sheet
With .Range("B2", .Cells(.Rows.Count, "B").End(xlUp)) ' reference referenced sheet column B range from row 2 down to last not empty one
For Each cell In Range("B3", Cells(Rows.Count, "B").End(xlUp)) ' loop through packinglist sheet (i.e. where button resides) column B cells from row 3 down to last not empty one
If Not .Find(what:=cell.Value2, LookIn:=xlValues, lookat:=xlWhole) Is Nothing Then ' if current packinglist item is in "master"
.Replace what:=cell.Value2, replacement:=vbNullString, lookat:=xlWhole ' temporarily replace master item with a blank
cell.Offset(, 22).Value2 = Replace(.SpecialCells(xlCellTypeBlanks).Address(False, False), "B", "") ' write master list blanks rows in packinglist sheet current item row and column "X"
.SpecialCells(xlCellTypeBlanks).Value = cell.Value2 ' restore master list current packinglist item value
End If
Next
End With
End With
End Sub
I would use a dictionary to store every item in the master sheet, and everytime you find it duplicate, add another number with its row like this:
Option Explicit
Private Sub CommandButton1_Click()
Dim MasterKeys As Object
MasterKeys = FillDictionary(MasterKeys)
With ThisWorkbook.Sheets("MySheet") 'change MySheet for your actual sheet name
Dim arr As Variant
arr = .UsedRange.Value 'drop your data inside an array
Dim i As Long
For i = 3 To UBound(arr) 'loop through all the rows in your data
If MasterKeys.Exists(arr(i, 2)) Then arr(i, 24) = MasterKeys(arr(i, 2))
Next i
.UsedRange.Value = arr 'drop back your data
End With
End Sub
Function FillDictionary(MasterKeys As Object) As Object
Set MasterKeys = CreateObject("Scripting.Dictionary")
With Workbooks("MasterWorkbook.xlsx").Sheets("master") 'change MasterWorkbook for the actual filename of your master workbook
Dim LastRow As Long
LastRow = .Cells(.Rows.Count, 2).End(xlUp).Row 'find the last row on column B
Dim C As Range
For Each C In .Range("B2:B" & LastRow) 'loop through the range
If Not MasterKeys.Exists(C.Value) Then
MasterKeys.Add C.Value, C.Row
Else
MasterKeys(C.Value) = MasterKeys(C.Value) & "," & C.Row
End If
Next C
End With
End Function

if column A has text and column G is blank then copy row to new spreadsheet

I am trying to create a summary list for people in a downstream application to feed several of my production machines. Each machine is going to have their own tab to request material, and I want all of their requests to be summarized on one tab (called "Core_Cutter_List").
So basically I am trying to create a VBA that will copy over a row from spreadsheet "2" into the next blank line on spreadsheet "Core_Cutter_List". I want it to copy if there is text in column A and column G is blank. I have limited knowledge of VBA. The code that I found was able to only test for one of my criteria which was that column G is blank, but basically it runs through every single cell on my file. Do you know how I can add the other criteria of column A having text in it so that it doesn't look through every cell on my sheet? Thanks for any help!
Sub Test()
'
' Test Macro
'
Sheets("2").Select
For Each Cell In Sheets(1).Range("G:G")
If Cell.Value = "" Then
matchRow = Cell.Row
Rows(matchRow & ":" & matchRow).Select
Selection.Copy
Sheets("Core_Cutting_List").Select
ActiveSheet.Rows(matchRow).Select
ActiveSheet.Paste
Sheets("2").Select
End If
Next
End Sub
If you need two conditions, then you should write them carefully in the IF statement with And:
Something like If cell.Value = "" And Len(cell.Offset(0,-6)) Then should be workable.
Using Select is a bit not advisable, but it works at the beginning - How to avoid using Select in Excel VBA
The Sub bellow does the following
Determine the last used row in Worksheets("2") based on values in column A
Determine the last used col in Worksheets("2") based on values in row 1
Determine the last used row in Worksheets("Core_Cutter_List") based on values in column A
Loop through all used rows in Worksheets("2")
If the cell in col A is not empty And cell in col G is empty
Copy entire row to next empty row in Worksheets("Core_Cutter_List")
Increment next empty row for Worksheets("Core_Cutter_List")
Loop to the next used row in Worksheets("2")
Option Explicit
Public Sub CopyRows()
Dim ws1 As Worksheet, ws2 As Worksheet, ws1r As Range, ws2r As Range
Dim ws1lr As Long, ws1lc As Long, ws2lr As Long, i As Long
Set ws1 = ThisWorkbook.Worksheets("2")
Set ws2 = ThisWorkbook.Worksheets("Core_Cutter_List")
ws1lr = ws1.Range("A" & Rows.Count).End(xlUp).Row 'last row in "2"
ws1lc = ws1.Cells(1, Columns.Count).End(xlToLeft).Column 'last col in "2"
ws2lr = ws2.Range("A" & Rows.Count).End(xlUp).Row + 1 'last row in "Core_Cutter"
For i = 1 To ws1lr
If Len(ws1.Cells(i, "A")) > 0 And Len(ws1.Cells(i, "G")) = 0 Then
Set ws1r = ws1.Range(ws1.Cells(i, 1), ws1.Cells(i, ws1lc))
Set ws2r = ws2.Range(ws2.Cells(ws2lr, 1), ws2.Cells(ws2lr, ws1lc))
ws2r.Value2 = ws1r.Value2
ws2lr = ws2lr + 1
End If
Next i
End Sub
My test file
Worksheets("2")
Worksheets("Core_Cutter_List")

Find last row in range

I'm having a little trouble with finding the last row.
What I am trying to do is find the last row in column "A", then use that to find the last row within a range.
Example of Data:
1) LR_wbSelect = wbshtSelect.cells(Rows.count, "A").End(xlUp).Row - 22
2) LR_wbSelectNew = wbshtSelect.cells(LR_wbSelect, "A").End(xlUp).Row
I am using the last row in column "A" as the data from row 29 down will always be the same length, the rows used in column "B" from row 29 can be a varying number of rows.
So I am trying to use LR_wbSelect in column "A" to get my starting last Row, then within LR_wbSelectNew using it as the starting point to look up from.
This works when the column I set to "A", LR_wbSelectNew gives me the row of "17", but when I change the column in LR_wbSelectNew to "B" it doesn't give the correct last row of "18".
I can change the column to "C, D, E, F" and the code works fine, but the only column that I can use is "B" because it will always have data in it, where the rest of that row could have a blank cell.
After doing some testing on the sheet, by pressing CRTL & Up from the lastring point of LR_wbSelect column "B" ignores the data in the rows and go to the row where it find data. I can't see a reason why Excel doesn't think there is data in these cells?
There are mulitple results and methods when searching for the LastRow (in Column B).
When using Cells(.Rows.Count, "B").End(xlUp).Row you will get the last row with data in Column B (it ignores rows with spaces, and goes all the way down).
When using:
With wbshtSelect.Range("B10").CurrentRegion
LR_wbSelectNew = .Rows(.Rows.Count).Row
End With
You are searching for the last row with data in Column B of the CurrentRegion, that starts from cell B10, untill the first line without data (it stops on the first row with empty row).
Full Code:
Sub GetLastRow()
Dim wbshtSelect As Worksheet
Dim LR_wbSelectNew As Long
' modify "Sheet2" to your sheet's name
Set wbshtSelect = Sheets("Sheet2")
' find last row with data in Column B
With wbshtSelect
LR_wbSelectNew = .Cells(.Rows.Count, "B").End(xlUp).Row
End With
' for debug only
Debug.Print LR_wbSelectNew ' >>result 31
' find last row with data in Column B at current regioun starting at cell B10
With wbshtSelect.Range("B10").CurrentRegion
LR_wbSelectNew = .Rows(.Rows.Count).Row
End With
' for debug only
Debug.Print LR_wbSelectNew ' >> result 18
End Sub
Edit1: code searches for last row for cells with values (it ignores blank cells with formulas inside).
Sub GetLastRow()
Dim wbshtSelect As Worksheet
Dim LR_wbSelectNew As Long
' modify "Sheet2" to your sheet's name
Set wbshtSelect = Sheets("Sheet2")
' find last row with data in Column B at current regioun starting at cell B10
With wbshtSelect.Range("B10").CurrentRegion
LR_wbSelectNew = .Rows(.Rows.Count).Row
End With
Dim Rng As Range
Set Rng = wbshtSelect.Range("B10:B" & LR_wbSelectNew)
' find last row inside the range, ignore values inside formulas
LR_wbSelectNew = Rng.Find(What:="*", _
After:=Range("B10"), _
LookAt:=xlPart, _
LookIn:=xlValues, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
' for debug
Debug.Print LR_wbSelectNew ' << result 18 (with formulas in the range)
End Sub
Hope this piece of code helps !
Sub LastRowInOneColumn()
'Find the last used row in a Column: column A in this example
Dim LastRow As Long
With ActiveSheet
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
End With
MsgBox LastRow
End Sub
I came here looking for a way to find the last row in a non-contiguous range. Most responses here only check one column at a time so I created a few different functions to solve this problem. I will admit, though, that my .Find() implementation is essentially the same as Shai Rado's answer.
Implementation 1 - Uses Range().Find() in reverse order
Function LastRowInRange_Find(ByVal rng As Range) As Long
'searches range from bottom up stopping when it finds anything (*)
Dim rngFind As Range
Set rngFind = rng.Find( What:="*", _
After:=rng.Parent.Cells(rng.row, rng.Column), _
LookAt:=xlWhole, _
LookIn:=xlValues, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious)
If Not rngFind Is Nothing Then
LastRowInRange_Find = rngFind.row
Else
LastRowInRange_Find = rng.row
End If
End Function
Implementation 2 - Uses Range().End(xlUp) on each column
Function LastRowInRange_xlUp(ByVal rng As Range) As Long
Dim lastRowCurrent As Long
Dim lastRowBest As Long
'loop through columns in range
Dim i As Long
For i = rng.Column To rng.Column + rng.Columns.count - 1
If rng.Rows.count < Rows.count Then
lastRowCurrent = Cells(rng.row + rng.Rows.count, i).End(xlUp).row
Else
lastRowCurrent = Cells(rng.Rows.count, i).End(xlUp).row
End If
If lastRowCurrent > lastRowBest Then
lastRowBest = lastRowCurrent
End If
Next i
If lastRowBest < rng.row Then
LastRowInRange_xlUp = rng.row
Else
LastRowInRange_xlUp = lastRowBest
End If
End Function
Implementation 3 - Loops through an Array in reverse order
Function LastRowInRange_Array(ByVal rng As Range) As Long
'store range's data as an array
Dim rngValues As Variant
rngValues = rng.Value2
Dim lastRow As Long
Dim i As Long
Dim j As Long
'loop through range from left to right and from bottom upwards
For i = LBound(rngValues, 2) To UBound(rngValues, 2) 'columns
For j = UBound(rngValues, 1) To LBound(rngValues, 1) Step -1 'rows
'if cell is not empty
If Len(Trim(rngValues(j, i))) > 0 Then
If j > lastRow Then lastRow = j
Exit For
End If
Next j
Next i
If lastRow = 0 Then
LastRowInRange_Array = rng.row
Else
LastRowInRange_Array = lastRow + rng.row - 1
End If
End Function
I have not tested which of these implementations works fastest on large sets of data, but I would imagine that the winner would be _Array since it is not looping through each cell on the sheet individually but instead loops through the data stored in memory. However, I have included all 3 for variety :)
How to use
To use these functions, you drop them into your code sheet/module, specify a range as their parameter, and then they will return the "lowest" filled row within that range.
Here's how you can use any of them to solve the initial problem that was asked:
Sub answer()
Dim testRange As Range
Set testRange = Range("A1:F28")
MsgBox LastRowInRange_Find(testRange)
MsgBox LastRowInRange_xlUp(testRange)
MsgBox LastRowInRange_Array(testRange)
End Sub
Each of these will return 18.
If your wbshtSelect is defined as worksheet and you have used set to define the specific worksheet, you can use this.
Dim LastRow As Long
wbshtSelect.UsedRange ' Refresh UsedRange
LastRow = wbshtSelect.UsedRange.Rows(wbshtSelect.UsedRange.Rows.Count).Row
Otherwise take a look here http://www.ozgrid.com/VBA/ExcelRanges.htm
LR_wbSelectNew = wbshtSelect.cells(LR_wbSelect, "B").End(xlUp).Row
Why are you using "LR_wbSelect" as the row counter? If you want to know the last row of column 'B', you should use Rows.count
Rows.count --> Returns maximum number of rows (which is 1048576 for Excel 2007 and up)
End(xlUp) --> Moves the pointer upward to the last used row
So,
cells(Rows.count, "A").End(xlUp).Row --> This moves the pointer to the last row if the column 'A' (as if you are pressing Crtl+Up keys when A1048576 cell is selected)
So, use Rows.count to select the last row for column 'B' as well. If you have some specific requirement related to LR_wbSelect, please mention it.
Alternatively, if you want to know the last row used in a sheet, you may use the below:
mySheet.Cells.SpecialCells(xlCellTypeLastCell).Row
LR_wbSelect = ThisWorkbook.Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Row
Simple function that return last row no. in specific sheet.
It takes the last address in UsedRange and retrieve last row number.
Feel to free change the code and use standard range insead of UsedRange.
Function FindLastRow(wsToCheck As Worksheet) As Long
Dim str As String
str = wsToCheck.UsedRange.AddressLocal()
FindLastRow = Right(str, InStr(1, StrReverse(str), "$") - 1)
End Function
Range().End will bring you to the end of a code block. If the starting cell is empty, it brings you the the first used cell or the last cell. It the cells is not empty it brings you to the last used cell. For this reason, you need to test whether or not the cell in column B is to determine whether to use LR_wbSelectNew as the last row.
With wbshtSelect
LR_wbSelect = .Cells(Rows.Count, "A").End(xlUp).Row - 22
If .Cells(LR_wbSelect, "B") <> "" Then
LR_wbSelectNew = LR_wbSelect
Else
LR_wbSelectNew = .Cells(LR_wbSelect, "B").End(xlUp).Row
End If
End With
This code defines a Target range that extends from A1 to the last row in column a - 22 and extends 10 columns.
Dim Target As Range
With wbshtSelect
Set Target = .Range("A1", .Cells(Rows.Count, "A").End(xlUp).Offset(-22)).Resize(, 10)
End With
'This is sure method to find or catch last row in any column even 'if some cell are blank in-between. (Excel-2007)`
'This works even if sheet is not active
'mycol is the column you want to get last row number
for n=1048575 to 1 step -1
myval=cells(n,mycol)
if myval<>"" then
mylastrow=n 'this is last row in the column
exit for
end if
next
ret=msgbox("Last row in column-" & mycol & "is=" & mylastrow)
Dim rng As Range
Dim FirstRow, LastRow As long
Set rng = Selection
With rng
FirstRow = ActiveCell.Row
LastRow = .Rows(.Rows.Count).Row
End With
Shai Rado's first solution is a great one, but for some it might need a bit more elaboration:
Dim rngCurr, lastRow
rngCurr = wbshtSelect.Range("B10").CurrentRegion
lastRow = rngCurr.Rows(rngCurr.Rows.Count).Row
If you want to know the last used row in the entire worksheet:
Dim rngCurr, lastRow
rngCurr = Range("A1").CurrentRegion
lastRow = rngCurr.Rows(rngCurr.Rows.Count).Row
Backing off from the range to the worksheet will get you the whole sheet extents of the range used on the sheet (which may be smaller than you expect if the sheet doesn't have data in the top rows; but it does include internal blanks)
TheRange.Worksheet.UsedRange.Rows.Count
If there is no data in the top rows, the following will get you the first row which you need to add to the above to get the highest row number
TheRange.End(xlDown).Row
So
Dim TheRange as Range
Dim MaxRow as Long
MaxRow = TheRange.Worksheet.UsedRange.Rows.Count + TheRange.End(xlDown).Row
Will get the highest row number with data (but not the whole sheet)
Before getting into complex coding why not build something on the below principle:
MaxRow = Application.Evaluate("MIN(ROW(A10:C29)) + ROWS(A10:C29) - 1")

VBA to add totals and formula to multiple sheets

I have an excel sheet with around 200 work sheets each containing a list of products sold to a company.
I need to add
A total at the bottom of row D-G where the bottom can be a different value. I.E. E4
below the total a formula based on the total. I.E. if E4 (being the bottom of the above row) is below $999 the display text "samples", if between 1000-3000 then multiply E4 by 2%, 3001-7500 x 5% etc.
I need to be able to add it to the entire workbook easily using vba. Since I must do this to numerous ss it would literally save me 15-20 hours a month.
Edit:
So I have something that seems to be the right path.
Sub Split_Worksheets()
Dim rRange As Range, rCell As Range
Dim wSheet As Worksheet
Dim wSheetStart As Worksheet
Dim strText As String
Set wSheetStart = ActiveSheet
wSheetStart.AutoFilterMode = False
'Set a range variable to the correct item column
Set rRange = Range("A1", Range("A65536").End(xlUp))
'Delete any sheet called "UniqueList"
'Turn off run time errors & delete alert
On Error Resume Next
Application.DisplayAlerts = False
Worksheets("UniqueList").Delete
'Add a sheet called "UniqueList"
Worksheets.Add().Name = "UniqueList"
'Filter the Set range so only a unique list is created
With Worksheets("UniqueList")
rRange.AdvancedFilter xlFilterCopy, , _
Worksheets("UniqueList").Range("A1"), True
'Set a range variable to the unique list, less the heading.
Set rRange = .Range("A3", .Range("A65536").End(x2Up))
End With
On Error Resume Next
With wSheetStart
For Each rCell In rRange
strText = rCell
.Range("A1").AutoFilter 1, strText
Worksheets(strText).Delete
'Add a sheet named as content of rCell
Worksheets.Add().Name = strText
'Copy the visible filtered range _
(default of Copy Method) and leave hidden rows
.UsedRange.Copy Destination:=ActiveSheet.Range("A1")
ActiveSheet.Cells.Columns.AutoFit
Next rCell
End With
With wSheetStart
.AutoFilterMode = False
.Activate
End With
On Error GoTo 0
Application.DisplayAlerts = True
Dim colm As Long, StartRow As Long
Dim EndCell As Range
Dim ws As Worksheet
StartRow = 3
For Each ws In Worksheets
Set EndCell = ws.Cells(Rows.Count, "c").End(xlUp).Offset(1, 1)
If EndCell.Row > StartRow Then EndCell.Resize(, 4).Formula = "=SUM(R" & StartRow & "C:R[-1]C)"
Set EndCell = ws.Cells(Rows.Count, "D").End(xlUp)
If EndCell.Row >= 1000 Then
Range(J2) = Formula = ((EndCell.Row) * (0.05))
Range(J3) = "5% Discount"
ElseIf EndCell.Row >= 3000 Then
Range(J2) = Formula = ((EndCell.Row) * (0.1))
Range(J3) = "10% Discount"
End If
Next ws
End Sub'
Just need to figure out how to display the results and text to the right cells (J2 in this case)
I will supply the logic and all the references you need to put this one together; and will let you try to put it together on your own :). Come back for more help if needed.
You need to loop through all the worksheets in your workbook (Microsoft Tutorial)
You need to find the last row for the given columns (Online tutorial)
You need to use an IF statement to choose which formula to use (MSDN reference)
UPDATE
What's wrong with your code is this line :
Range(J2) = Formula = ((EndCell.Row) * (0.1))
What you're telling the computer is :
Multiply EndCell.Row by 0.1 (which has the number of the row below and to the right of the last cell in column C)
Compare Formula with the result previously obtained
Store the result of that logical expression at the range stored in variable J2
First of all, what you want is to put the result of the equation, and want to change J2 to "J2" so it gets the cell J2, instead of the what's contained in J2 (which has nothing at that point)
Also, you seem to say that you're not getting the right cells, maybe it is caused by this :
Set EndCell = ws.Cells(Rows.Count, "c").End(xlUp).Offset(1, 1)
In that line, you're finding the last cell of column C, but then you select the cell below, and to the right of it.
There are so many things wrong with your code it's hard to say what's not working properly.

Resources