I have I data set on Excel. Starting at column B, it has continuous data from B3 to a variable number that periodically get larger (today it is B114, but tomorrow the data may extend to B116, for example). The data in cell B in continuous and is never deleted. For every row of continuous data in column B, I want to select column B-AG's rows as well. However, the rows after B do NOT have continuous data.
For example: There is continuous data from B3 to B120. I want to select the range B3:AG120.
The code I have written to do this in VBA is not working. It correctly stops at B120 (in this example), however, once it reaches the non-continuous data in columns C-AG, it freaks out and selects rows past 120. I am not positive why this code is not working, any help is much appreciated!
For the record, there are formulas in nearly every cell in the sheet. Only some formula populate the cell with data, however. I want to select every cell regardless of if it is populated with data IF IT IS IN MY RANGE. Otherwise, I do not want to select it. For example, past B120 there are empty cells with formulas in them. I do not want to include those in my range. But if there is an empty cell in D40 (in between B3 and AG120) I do want to include that in the selection.
Dim LR As Long, cell As Range, rng As Range
With Sheets("Sortable(2)")
LR = .Range("B" & Rows.Count).End(xlUp).Row
For Each cell In .Range("B3:B" & LR)
If cell.Value <> "" Then
If rng Is Nothing Then
Set rng = cell
Else
Set rng = Union(rng, cell)
End If
End If
Next cell
rng.Select
End With
Dim lastVal As Range, sht As Worksheet
Set sht = Sheets("Sortable(2)")
Set lastVal = sht.Columns(2).Find("*", sht.Cells(1, 2), xlValues, _
xlPart, xlByColumns, xlPrevious)
Debug.Print lastVal.Address
sht.Range("B2", lastVal).Resize(, 32).Select 'select B:AG
Related
So I have several worksheets on the same Excel workbook that I need to compare. Worksheet 1 is the masterlist, and I need to compare worksheets 1-2, 1-3, 1-4. I then need to paste any similar 1-2 data cells in column A of worksheet 5, and similar 1-3 data cells in column B of worksheet 5, and 1-4 similarities to column C of worksheet 5. For starters I have focused on getting the 1-2 comparison to work. So far I have been able to get my test number to be pasted to cell A1 of sheet 5. I am running into trouble because it only works for 1 cell, and I cannot get the program to paste a similarity in A1, and then A2... etc, when I have multiple similar items. They just overwrite each other in cell A1, or in the entire A column. I am also running into trouble because the program as it is written stops when it hits a blank space, but I need it to just skip the blanks and read the next cell when it comes across them. This is because my data sheets are very messy and the data is scattered over several thousands of rows among several different columns, with spaces randomly interjected. Below is my working code for just reading a similarity, and pasting it into A1. I should note that I have considered adding a specific cell range depending on which sheet I am on in order to put an end point on the program, but I haven't quite figured out how to work it in.
Sub findDuplicates()
' code to find duplicates in 2 different worksheets
Dim rng1, rng2, rngA, cell1, cell2 As Range
' 4 ranges have been defined
Set rng1 = Sheets("Sheet1").Range("C:C")
'rng1 defines the existing data in column C and worksheet1
Set rng2 = Sheets("Sheet2").Range("C:C")
'rng2 defines the data in column C and worksheet2
Set rngA = Sheets("Sheet5").Range("A1")
For Each cell1 In rng1
If IsEmpty(cell1.Value) Then Exit For
'check for empty rows. If true then exit the program
For Each cell2 In rng2
If IsEmpty(cell2.Value) Then Exit For
If cell1.Value = cell2.Value Then
'compare data in cell1 and cell2 and then copy/paste if they have equal values
cell1.Copy
Sheets("Sheet5").Select
rngA.Select
ActiveSheet.Paste
End If
'run the looping process
Next cell2
Next cell1
End Sub
The general idea of what I imagine the program to look like would be something like
Define ranges
Block of code that runs through each cell in sheet 1 comparing it to all cells in sheet 2.
Block of code that, when similarities are found, copy/paste that cell on sheet 1 to sheet 5 column A
*Program resumes scan from the next cell on sheet 1*
Block of code that breaks the program when it hits the end of the specified cell range
Any help with this would be greatly appreciated! You would be saving me at least a week's worth of mindless work.
A few comments about your code:
Dim rng1, rng2, rngA, cell1, cell2 As Range means only cell2 is defined As Range, while rng1, rng2, rngA, cell1 defined As Variant
You don't need to have 2 For loops to compare, you can replace the second For loop with the Match function, it will save you precious run-time.
You need to find the next empty row in "Sheet5", by using NextRow = Sheets("Sheet5").Cells(Sheets("Sheet5").Rows.Count, "A").End(xlUp).Row + 1
Last, you don't need to Select the sheets in order to copy>>paste, you can so it in 1-line (see in my code below).
Code
Sub findDuplicates()
' code to find duplicates in 2 different worksheets
' 4 ranges have been defined
Dim rng1 As Range, rng2 As Range, rngA As Range, cell1 As Range, cell2 As Range
Dim NextRow As Long
'rng1 defines the existing data in column C and "Sheet1"
Set rng1 = Sheets("Sheet1").Range("C:C")
'rng2 defines the data in column C and "Sheet2"
Set rng2 = Sheets("Sheet2").Range("C:C")
Set rngA = Sheets("Sheet5").Range("A1")
For Each cell1 In rng1
If Not IsEmpty(cell1.Value) Then ' only check non-empty cells
If Not IsError(Application.Match(cell1.Value, rng2 , 0)) Then ' <-- confirm match was asuccessful
' find next empty row in column "A" in "Sheet5"
NextRow = Sheets("Sheet5").Cells(Sheets("Sheet5").Rows.Count, "A").End(xlUp).Row + 1
' Copy >> Paste in 1 line (without need to Select the Sheets)
cell1.Copy Destination:=Sheets("Sheet5").Range("A" & NextRow)
End If
'run the looping process
End If
Next cell1
End Sub
Your problem is that rngA points to A1 and nothing changes that.
Add one line after your paste command:
ActiveSheet.Paste
Set rngA = rngA.Offset(1,0) ' This will move the pasting location one step down
I am pretty new to VBA and I have been fighting with creating one simple report for many days so I decided to inquire for some help. I will be really grateful for any tips you have or could point to any errors I might've made in my code.
I have the below piece of code (extracted from my loop). What I want to do is to create a list based on around 20 excel files that will have below stats:
name of the current tab inside the workbook
count of nonblanks in a column which name contains word "Difference" (always in row 7 but can be in different columns)
count from the same column but where cells are not blank AND different than 0.
For the last stat I didn't even start so you won't see it in my code but I would appreciate if you have any tips for this one too (which method best to use).
Windows("PassRate.xlsm").Activate
b = ActiveSheet.Cells(Rows.count, 2).End(xlUp).Row + 1
Cells(b, 3) = xlWorkBook.Worksheets(i).Name
xlWorkBook.Worksheets(i).Activate
Set Myrng = Range("B7:M9999").Find(What:="Difference", LookAt:=xlPart, SearchOrder:=xlByColumns, MatchCase:=False)
If Not Myrng Is Nothing Then
RowQnt = xlWorkBook.Worksheets(i).Myrng.Offset(9999, 2).Cells.SpecialCells(xlCellTypeConstants).count
End If
Windows("PassRate.xlsm").Activate
Cells(b, 4) = RowQnt
My problem is that the macro runs and works, but the result I get is the list of tab names but all counts are 0 and I cannot overcome this issue. For the line number 7 I've also tried the piece of code below which yields the same result.
RowQnt = xlWorkBook.Cells(Rows.count, Myrng).End(xlUp)
Is it possible that my problem is due to the fact that in the source files the column containing word "Difference" is sometimes two merged columns? Unfortunately, I cannot change that as these are some automatically generated files from another program.
xlWorkBook.Worksheets(i).Myrng isn't a valid Range syntax while you can simply use MyRng which you already set to a not null Range reference and already has both parent worksheet and workbook references inside it
but even Myrng.Offset(9999, 2).Cells wouldn't do since it references one cell only and not a range of cells
you need a Range(Range1, Range2) syntax, where both Range1 and Range2 are valid Range references to the first and last cell of the range you actually want to count not blank cells of
furthermore you could use WorksheetFunction.CountA() function instead of SpecialCells(xlCellTypeConstants) range, since this latter errors out if no constant cells are found in the range it's being applied to (so you'd need a check) while the former simply returns zero if no not empty cells are found
for all what above you could write the following GetRowQnt() function:
Function GetRowQnt(sht As Worksheet) As Long
Dim Myrng As Range
With sht '<--| reference passed worksheet
Set Myrng = .Rows(7).Find(What:="Difference", LookAt:=xlPart, SearchOrder:=xlByColumns, MatchCase:=False) '<--| find "Difference" in its 7th row
If Not Myrng Is Nothing Then GetRowQnt = WorksheetFunction.CountA(.Range(.Cells(8, Myrng.Column), .Cells(WorksheetFunction.Max(.Cells(.Rows.count, Myrng.Column).End(xlUp).row, 8), Myrng.Column))) '<--| count not blank cells in column where "Difference" was found from row 8 down to its last not empty cell
End With
End Function
and use it in your main code as follows:
With Windows("PassRate.xlsm").ActiveSheet '<--| reference "PassRate.xlsm" workbook active sheet (or change 'ActiveSheet' with 'Worksheetes("yourSheetName")')
For i = 1 To xlWorkbook.Worksheets.count '<--| loop through 'xlWorkbook' workbook worksheets
b = .Cells(.Rows.count, 3).End(xlUp).row + 1 '<--| get "PassRate.xlsm" workbook active sheet current first empty cell in column "C"
.Cells(b, 3) = xlWorkbook.Worksheets(i).Name
.Cells(b, 4) = GetRowQnt(xlWorkbook.Worksheets(i))
Next
End With
please note that with
b = .Cells(.Rows.count, 3).End(xlUp).row + 1
I took column "C" as the leading one to get last not empty row from, since there was no code in your post that wrote something in column "B".
But if your real code has some
.Cells(b, 2) = somedata '<--| write something in column "B" current row
then you can go back to b = .Cells(.Rows.count, 2).End(xlUp).row + 1
I would like to format a certain range in a worksheet as a table in Excel. The formatting will always start in row 10.
In order to do so, I have written the following code:
Set rng = Range(Range("B10"), Range("B10").End(xlUp).SpecialCells(xlLastCell))
Set table = Sheets("Results").ListObjects.Add(xlSrcRange, rng, , xlYes)
table.TableStyle = "TableStyleMedium13"
As of now, the formatting is done from row 10 until the end of the worksheet - even in empty rows. However, I would like the table to be formatted only up until the last row of data and for it to do this dynamically given the fact that the amount of data will vary. How can I do this?
The code below will format all cells from "B10" until last row with data in Column B (it will also format blank rows in the middle, in case you have gaps).
Dim LastRow As Long
With Sheets("Results")
' find last row with data in Column B
LastRow = .Cells(.Rows.Count, "B").End(xlUp).Row
' set Rng from B10 untill last row with data in Column B
Set Rng = Range("B10:B" & LastRow)
Set Table = .ListObjects.Add(xlSrcRange, Rng, , xlYes)
Table.TableStyle = "TableStyleMedium13"
End With
Range("B" & Rows.Count).End(xlUp)
This should work - will simply identify last populated row.
I am looking for code for two different types of selection. One code would select in an L shape all of the rows in one column and all of the columns in one row. In the example of having data in the range A1:A10, and data in row 10 only from col A - K. The selection would look like an L. How can you do this without knowing how many rows or columns have data in them?
The second code would have the same data, but need to select the whole range A1:K10 in that example, but the code would need to select whatever range had the data.
i found the answer. i have to do a union. here is the code with the union at the end.
Sub mywork()
Dim ws As Worksheet
Dim lRow As Long, lCol As Long
Dim rng As Range
'~~> Set this to the relevant worksheet
Set ws = [Sheet1]
With ws
'~~> Get the last row and last column
lRow = .Range("A" & .Rows.Count).End(xlUp).Row
lCol = .Cells(lRow, .Columns.Count).End(xlToLeft).Column
'~~> Set the range
Set rng = .Range(.Cells(lRow, 1), .Cells(lRow, lCol))
End With
Set rng = Application.Union(Range("A1:A" & lRow), rng)
rng.Select
End Sub
activesheet.usedrange.address should tell you the used range.
In your case something like this should work: [sheet1].usedrange.select (Replaces all the code in the module)
The benefit here is the fact that you are not hard coding "A1:A" against the last identified cell, works well if you have blank rows at the top.
I'm just getting started with VBA for Excel. I used VB and Java in college nearly ten years ago and was competent with it then, but am essentially starting over. (Um, not like riding a bike.)
I am trying to understand the methods to build a range that isn't just declared as A1:J34 or whatever. My Googling is challenged in that when searching for 'range' and terms that indicate what I seek, I get an avalanche of hits far more advanced than what I need, mostly hits that don't even address the basic summary info I need.
So, here's the basics of it:
Excel 2011 on Mac.
The sheet has data from A to M, down to 1309.
It's a repeating pattern of heading rows followed by data rows. Ugh. Seems like the person creating the sheet was more thinking about printing from the sheet than the organisation of the data. I need to clean it and 3 more like it up to use in a pivot table, and it's useless in this silly repeating layout.
Heading rows are as follows:
Last Name, First Name, then 10 date cells.
Data rows under the headings are the names, of course, and then a 1 or 0 for attendance.
Anywhere from 20 to 30 names under each heading. Then it repeats. And the dates change every few sets, picking up where the last set left off.
What I need to do right now:
I'm trying to assemble a range into a range variable by adding all the rows beginning with a specific value (in column A). In my case that value is the string "Last Name", so I can have the range variable holding all the cells in all rows that begin with "Last Name". This will then capture all the cells that need to be in date format. (I'm doing it so I can then make sure the date headings are all actually IN date format - because they are NOT all in date format now, many are just 'General' cells.)
My questions:
When telling a range object what it's range IS, how do you feed it cells/rows/columns that are not just a block defined by start and end cells entered by the person writing the code but based on row criteria? Eg: Create a Range that has rows 1, 34, 70, 93, and 128 from columns A to I based on presence of "First Name" in A.
What are the most common methods to do this?
Which of these is best suited to my need and why?
Here's a working example that demonstrates finding the "Last Name" rows, contructing a range object that includes all those rows, and then iterating through that object to search for non-date values. The code could be speeded up greatly by reading the data range into an array of variants and then searching the array for both the last name rows and the "bad dates" within those rows. This is especially true if you have a very large number of rows to check.
Sub DisjointRng()
Dim checkCol As String, checkPattern As String
Dim dateCols()
Dim lastCell As Range, usedRng As Range, checkRng As Range
Dim cell As Variant
Dim usedRow As Range, resultRng As Range, rngArea As Range
Dim i As Long, j As Long
checkCol = "A" 'column to check for "Last Name"
checkPattern = "Last*"
dateCols = Array(3, 5) 'columns to check for date formatting
With Worksheets("Sheet1")
'find the bottom right corner of data range; we determine the used range
'ourselves since the built-in UsedRange is sometimes out-of-synch
Set lastCell = .Cells(.Cells.Find(What:="*", SearchOrder:=xlRows, _
SearchDirection:=xlPrevious, LookIn:=xlFormulas).Row, _
.Cells.Find(What:="*", SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious, LookIn:=xlFormulas).Column)
Set usedRng = .Range("A1:" & lastCell.Address)
'the column of values in which to look for "Last Name"
Set checkRng = .Range(checkCol & "1:" & checkCol & usedRng.Rows.Count)
End With
'step down the column of values to check for last name & add
'add found rows to range object
For Each cell In checkRng
If cell.Value Like checkPattern Then
'create a range object for the row
Set usedRow = Intersect(cell.EntireRow, usedRng)
If resultRng Is Nothing Then
'set the first row with "Last Name"
Set resultRng = usedRow
Else
'add each additional found row to the result range object
Set resultRng = Union(resultRng, usedRow)
End If
End If
Next cell
For Each rngArea In resultRng.Areas
'if found rows are continguous, Excel consolidates them
'into single area, so need to loop through each of the rows in area
For i = 1 To rngArea.Rows.Count
For j = LBound(dateCols) To UBound(dateCols)
If Not IsDate(rngArea.Cells(i, dateCols(j))) Then
'do something
End If
Next j
Next i
Next rngArea
End Sub
You can use the Union operator, like this
Dim r As Range
Set r = Range("A1, A3, A10:A12")
or this
Set r = Union(Range("A1"), Range("A3"), Range("A10:A12"))
You can the iterate this range like this
Dim cl as Range
For Each cl in r.Cells
' code cell cl
Next
or this
Dim ar as Range
For each ar in r.Areas
' code using contiguous range ar
For each cl in ar.Cells
' code using cell cl
Next
Next