Im looking to compare all entries in column B of WB1 (can vary in amount up to 300,000), versus a master listing in WB2,tab "Guide", column A (circa 500 entries).
If there are new entries in column B of WB1, i have a msgbox appear listing the new types to be added to the master listing in WB2.
I would also like a msgbox to appear saying "all types valid" if there are no new types found
Any help greatly appreciated.
Sub Compare()
Dim sh1 As Worksheet
Dim sh2 As Worksheet
Dim lr1 As Long
Dim lr2 As Long
Dim rng1 As Range
Dim rng2 As Range
Dim c As Range
Dim msg As String
msg = "New types: "
Set sh1 = Sheets(1)
Workbooks.Open Filename:="filepath\Types.xls"
Set sh2 = Worksheets("Guide")
lr1 = Application.WorksheetFunction.CountA(sh1.Columns(1))
lr2 = Application.WorksheetFunction.CountA(sh2.Columns(1))
Set rng1 = sh1.Range("B2:B" & lr1)
Set rng2 = sh2.Range("A2:A" & lr2)
For Each c In rng1
If Len(c.Value) > 0 And Application.CountIf(rng2, c.Value) = 0 Then
msg = msg & vbNewLine & c.Value
End If
Next
Workbooks("Types.xls").Close SaveChanges:=False
MsgBox msg
End Sub
You declare k As Integer but Excel has more rows than Integer can handle. Declare all row/column counting variables as Long instead.
Actually there is no benefit in using Integer instead of Long in VBA therefore I recommend always to use Long. Only some very rare cases really need Integer:
Why Use Integer Instead of Long?
Also your CountIf statement is wrong and missing the criteria:
If Application.WorksheetFunction.CountIf(S1.Range(S1.Cells(2, 2), S2.Cells(j, 1)), Then
Should look like
If Application.WorksheetFunction.CountIf(S1.Range(S1.Cells(2, 2), S2.Cells(j, 1)), CRITERIA) Then
Where CRITERIA needs to be replaced by your count criteria.
Related
I have some code that doesn't work like I think it would. It is supposed to filter on column AL for "1", then delete all rows that are visible, then show all rows afterwards. My data starts in column P and I counted that column AL is 23 columns away from P so I put 23 for the field. I have headers in the first 3 rows so I have set it to offset 3 rows.
When I run it, it says
Method 'Range' of object '_Worksheet' failed
I'm a beginner at VBA so I'm still learning but I'm just not sure what part of this is causing the error. I tried everything I could think of to my limited ability. As far as I can tell...it should work based on Googling other people's code that was similar.
This is the section of code in question:
Sub copypaste()
Dim c As Range
Dim IRow As Long, lastrow As Long
Dim rSource As Range
Dim wsI As Worksheet, wsO As Worksheet
Dim endrow As Long
Set wsI = ThisWorkbook.Sheets("Sheet2")
Set wsO = ThisWorkbook.Sheets("Sheet1")
Application.ScreenUpdating = False
With wsO
wsO.Range("AL" & Lines).AutoFilter Field = 22, Criteria1:="1"
wsO.Range("AL" & Lines).Offset(3, 0).SpecialCells _
(xlCellTypeVisible).EntireRow.Delete
wsO.ShowAllData
End With
Your problem is this:
wsO.Range("AL" & Lines)
You have not declared or assigned a value to Lines.
Also you will want to include the whole range of the table and not just that one column:
wsO.Range("P2:AL" & Lines)
So:
Sub copypaste()
Dim c As Range
Dim IRow As Long, lastrow As Long
Dim rSource As Range
Dim wsI As Worksheet, wsO As Worksheet
Dim endrow As Long
Dim Lines As Long
Set wsI = ThisWorkbook.Sheets("Sheet2")
Set wsO = ThisWorkbook.Sheets("Sheet1")
Application.ScreenUpdating = False
With wsO
Lines = .Cells(.Rows.Count, "P").End(xlUp).Row
.Range("P13:AL" & Lines).AutoFilter field:=23, Criteria1:="1"
On Error Resume Next
.Range("P14:AL" & Lines).SpecialCells(xlCellTypeVisible).EntireRow.Delete
On Error Goto 0
.ShowAllData
End With
I have a list of product details in excel, headers in row 2, products details from row 3.
In column C, I have status of either Open or Closed and I want vba codes that can delete the whole range if the list is Open only, hence, no Closed if found. If data has both Closed and Open or just Closed, I don't have to do anything, just leave the data as it is.
This is part of the larger codes I have already written, so that is why I am hoping to achieve this using vba codes.
I am not sure if I need to set my range to column C and how to interpret rng.Cells(q, 1).Value. Right now it looks like my codes just step through and no error but nothing happens. I have provided pic of my test data and results.
Sub test()
Dim Satus As Worksheet
Dim LR1, q As Long
Dim rng As Range
Set Status = Worksheets("Sheet1")
LR1 = Status.Cells(Rows.Count, "B").End(xlUp).Row
Set rng = Status.Range("B2:G" & LR1)
For q = 3 To LR1
If InStr(1, rng.Cells(q, 1).Value, "Closed") = 0 Then
Else
Status.Columns("B:G").EntireColumn.Delete
Status.Range("B2").Value = "No Closed Status"
End If
Next q
End Sub
It's much simpler by directly working with objects and using Excel's native functions:
Option Explicit
Sub Test()
Dim Status As Worksheet
Set Status = Worksheets("Sheet1")
With Status
Dim LR1 As Long
LR1 = .Range("B" & .Rows.Count).End(xlUp).Row
If .Range("C3:C" & LR1).Find("Closed", lookat:=xlWhole) Is Nothing Then
.Range("C3:C" & LR1).EntireRow.Delete
End If
End With
End Sub
Is Nothing is because .Find returns a range object if it's found. If it doesn't find it it will return, essentially, nothing.
It is simple to use Worksheetfunction countif.
Sub test()
Dim Satus As Worksheet
Dim LR1, q As Long
Dim rng As Range, rngDB As Range
Dim cnt As Long
Set Status = Worksheets("Sheet1")
With Status
LR1 = .Cells(Rows.Count, "B").End(xlUp).Row
Set rng = Status.Range("B2:G" & LR1)
Set rngDB = .Range("c3:c" & LR1)
cnt = rngDB.Rows.Count
If WorksheetFunction.CountIf(rngDB, "Open") = cnt Then
rng.EntireColumn.Delete
.Range("B2").Value = "No Closed Status"
.Range("a1") = "Data1 Result"
End If
End With
End Sub
I think this should solve your problem. You can't decide in the for loop a state for a whole column. You have to collect all single states and execute a change afterwards.
Sub test()
Dim Satus As Worksheet
Dim LR1, row As Long
Dim rng As Range
'Dim lOpen As Long
Dim lClosed As Long
Set Status = ThisWorkbook.ActiveSheet
LR1 = Status.Cells(Rows.Count, "B").End(xlUp).row
Set rng = Status.Range("B2:G" & LR1)
rngStart = 2 ' because of header line
rngEnd = rng.Rows.Count - 1 ' likewise
For row = rngStart To rngEnd
Select Case rng.Cells(row, 2).Value
'Case "Open" ' just in case for future use
' lOpend = lOpend + 1
Case "Closed"
lClosed = lClosed + 1
Case Else
End Select
Next row
If lClosed = 0 Then
rng.EntireColumn.Delete ' delete just the data range
Status.Range("B2").Value = "No Closed Status"
End If
End Sub
I want to create two variables, one for the row number of the first integer in column J and one for the last integer in column J (after this there are many rows of #N A N A). I then would like to use these two points to create a range for column J but also for column D (using the same variables)
I just started using vba earlier this week, understand the simplicity and I have found similar answers elsewhere but none quite so specific. Any help would be much appreciated. What I have so far:
Dim StartRow As Integer
Dim sht As Worksheet
Dim LastRow As Integer
Dim JRange As Range
Dim DRange As Range
Set StartRow = Range("j7:j100").SpecialCells(xlCellTypeConstants, xlNumbers).Cells(1, 1).Row
LastNonRow = sht.Cells(sht.Rows.Count, 8).End(xlUp).Row (I fear this includes the #N A N A rows too)
Set JRange = sht.Range(StartRow,10,sht.Cells(LastRow,10))
Set DRange = sht.Range(StartRow,4,sht.Cells(LastRow,4))
First, you should use:
Set JRange = sht.Range(sht.Cells(StartRow,10),sht.Cells(LastRow,10))
Second, don't use the Set keyword with Integer or other value types. The Set keyword is only for use with objects. If you are not familiar with object vs. value types, you should do some research on that. Here are some Excel VBA examples:
Dim i As Integer
Dim j As Double
dim str as String
Dim coll As Collection
dim sht As Worksheet
dim rng As Range
i = 1
j = 2.4
str = "This is a string of text, also a value type"
Set coll = ThisWorkbook.Sheets 'Note that ThisWorkbook.Sheets is a Collection
Set sht = coll(1) 'sets sht to the first Sheet in coll
Set rng = sht.Range("A1")
If you just care whether a number is in the cell and not necessarily an integer, you can do something like this
'Use Double instead of Integer because the possible range of values is larger.
'This reduces risk of error
Dim LastRow As Double
Dim UpperLimit As Double
'Assuming you already have StartRow
LastRow = StartRow + 1
'Use UpperLimit to ensure you don't go into an infinite loop
'Set UpperLimit to an appropriately high value
UpperLimit = 100000
'Test Loop
Do While IsNumeric(sht.Cells(LastRow,10).Value) and LastRow <= UpperLimit
LastRow = LastRow + 1
Loop
'Check if it exceeded upper limit
If LastRow > UpperLimit Then
MsgBox "Exceeded Limit"
Exit Sub
End If
LastRow = LastRow - 1 'Because the sht.Cells(LastRow,10).value is non-numeric
'Now set ranges
If you care whether it is actually an integer, you can use the above code, but put a conditional statement inside the loop to test whether the number is indeed an integer. There are many resources on the web that give code for determining whether value is an integer.
Also, you should make sure you set the sht variable before you use it.
Set sht = ThisWorkbook.Sheets(1)
Or
Set sht = ThisWorkbook.Sheets("MySheetName")
Hope this helps.
EDIT:
If the range is not continuous with integers, reverse the loop:
LastRow = UpperLimit
Do Until IsNumeric(sht.Cells(lastRow,10).Value)) Or LastRow = StartRow
LastRow = LastRow - 1
Loop
If you do this, remove the LastRow = LastRow-1 from the end of the code as the value you are looking for is already in LastRow.
There's a bunch of issues with your code:
Set StartRow - You only use Set when you're creating an object.
Also there's an issue with referencing the cells. There are a bunch of different ways to do this, I suggest to read up on this.
The following will take the first row with a number and the last row with a number, even if there are Non-number values in between. It will run on the currently active sheet.
Sub test()
Dim StartRow As Integer
Dim LastRow As Integer
Dim JRange As Range
Dim DRange As Range
Dim RangeForLoop As Range
StartRow = Range("J7:J100").SpecialCells(xlCellTypeConstants, xlNumbers).Cells(1, 1).Row
For Each RangeForLoop In Range("J7:J100").SpecialCells(xlCellTypeConstants, xlNumbers).Cells
LastRow = RangeForLoop.Row
Next RangeForLoop
Set JRange = Range("J" & StartRow & ":J" & LastRow)
Set DRange = Range("D" & StartRow & ":D" & LastRow)
End Sub
Excel VBA - Select a range using variables & COUNTA
Hi Staked VBA Kings & Queens, I'm trying to learn Excel VBA. A simple task I would like to do is select all the contagious cells in a report dump I get from sales. Simple i'm sure, but I am a total beginner at VBA.
Ok Report Info:
The report is a set number of columns (31). Although I would like to build a bit of variability into my code to accommodate a change in column numbers.
The report grows by number of rows each week, some times less, sometimes more. But Always starts at cell [A4].
I though of using COUNTA function to count used number of rows, then set that as a variable. Similar with rows.
This is what I came up with, although I get a "Run-time Error '1004': Method 'Range' of object'_Global failed... can anyone help me out".
For me the key is to learn VBA using task I need getting done. I understand the logic behind my code, but not exactly the write way to write it. If some proposes a totally different code I might get lost.
But I am open minded.
Sub ReportArea()
Dim numofrows As Integer
Dim numofcols As Integer
Dim mylastcell As String
Dim myrange As Range
Worksheets("Sheet1").Select
numofrows = WorksheetFunction.CountA(Range("AE:AE"))
numofcols = WorksheetFunction.CountA(Range("4:4"))
Set myrange = Range(Cells(4, 1), Cells(numofrows, numofcols))
Range(myrange).Select
End Sub
P.S I did try read slimier trends but only got confused as the solution where very involved.
Find last row and last column
Sub Sht1Rng()
Dim ws As Worksheet
Dim numofrows As Long
Dim numofcols As Long
Dim myrange As Range
Set ws = Sheets("Sheet1")
With ws
numofrows = .Cells(.Rows.Count, "AE").End(xlUp).Row
numofcols = .Cells(4, .Columns.Count).End(xlToLeft).Column
Set myrange = .Range(.Cells(4, 1), .Cells(numofrows, numofcols))
End With
MsgBox myrange.Address
End Sub
You can also use this code.
Sub SelectLastCellInInSheet()
Dim Rws As Long, Col As Integer, r As Range, fRng As Range
Set r = Range("A1")
Rws = Cells.Find(what:="*", after:=r, SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
Col = Cells.Find(what:="*", after:=r, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
Set fRng = Range(Cells(2, 1), Cells(Rws, Col)) ' range A2 to last cell on sheet
fRng.Select 'or whatever you want to do with the range
End Sub
Further to my above comment, is this what you are trying?
Sub ReportArea()
Dim ws As Worksheet
Dim Lrow As Long
Dim myrange As Range
Set ws = ThisWorkbook.Sheets("Sheet1")
With ws
'~~> Find Last row of COl AE. Change it to the relevant column
Lrow = .Range("AE" & .Rows.Count).End(xlUp).Row
Set myrange = .Range("A4:AE" & Lrow)
With myrange
'
'~~> Do whatever you want to do with the range
'
End With
End With
End Sub
Note: Also you don't need to select a range/worksheet. Work with objects. Interesting Read
alternative solutions to already posted:
1:
Dim LRow&, LColumn&
Lrow = Sheets("SheetName").Cells.SpecialCells(xlCellTypeLastCell).Row
LColumn = Sheets("SheetName").Cells.SpecialCells(xlCellTypeLastCell).Column
MsgBox "Last Row is: " & Lrow & ", Last Column is: " & LColumn
2:
Dim x As Range
Set x = Range(Split(Sheets("SheetName").UsedRange.Address(0, 0), ":")(1))
MsgBox "Last Row is: " & x.Row & ", Last Column is: " & x.Column
output result
I have been struggling for a day and a half with my code. I have a spreadsheet with over 50 columns 18000 rows. I have been able to identify a smaller range of cells in column A defined by "AllEntRg" based on blank cells in column H(OpsCol). I'm stuck with my loops towards the bottom. For EntityRg, I am looping through each cell in "AllEntRg" and if it is Not found in Range CCRg which was defined in BudWb Wk4 Then I want to create a range of all of those cells. The next option, CostCRg, I want to define a range for all cells that ARE FOUND in CCrg.
I have tested this by selecting individual cells and it provides the results I'm looking for but when I have this in the loops I'm getting the following two results: For EntityRg, the range.address defined is the same as AllEntRg (this shouldn't be the case). For CostCRg, I'm getting an error. I'm not sure what I'm not defining correctly. I've been stuck here for quite a while and I have tried using Match Function as well. Again, individually it works but in the loop I'm getting these results which are not expected. I'm interested on the feedback I may receive. Thanks.
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Dim wb As Workbook
Dim BudWkb As Workbook
Dim Wk2 As Worksheet
Dim PNLWkb As Workbook
Dim fpath As String
Dim fname As String
Set BudWkb = Workbooks("SubModel Forecast_Other Admin v4.xlsm")
Set Wk2 = BudWkb.Sheets("By PM")
fname = "Feb15 PNL"
'fname = InputBox("Enter PNL File Name")
Dim Wk4 As Worksheet
Set Wk4 = BudWkb.Sheets("Validation")
With Wk4
Dim CCCol As Long
Dim fRowCC As Long
Dim lRowCC As Long
CCCol = Wk4.Cells.Find("Cost Center", lookat:=xlWhole).Column
fRowCC = Wk4.Cells.Find("Cost Center", lookat:=xlWhole).Offset(1, 0).row
lRowCC = Wk4.Cells.Find("Cost Center", lookat:=xlWhole).End(xlDown).row
Dim CCRg As Range
Set CCRg = Wk4.Range(Wk4.Cells(fRowCC, CCCol), Wk4.Cells(lRowCC, CCCol))
'MsgBox (CCRg.Address)
End With
Set PNLWkb = Workbooks("Feb15 PNL.xlsx")
Dim Wk1 As Worksheet
Set Wk1 = PNLWkb.Sheets("det")
With Wk1
If Left(Wk2.Name, 5) = "By PM" Then
Dim OpsCol As Long
OpsCol = Wk1.Cells.Find("Property Manager", lookat:=xlWhole).Column
Else
OpsCol = Wk1.Cells.Find("Submarket", lookat:=xlWhole).Column
End If
Dim FRow As Long
Dim lRow As Long
Dim ExpCol As Long
Dim PropCodeCol As Long
Dim Expense As String
Expense = InputBox("Enter Expense GL")
'to locate begining and ending row of data on PNL report
'Identifies the column where the SubMarket names are located for lookup purposes
'Defines the expense GL column to lookup based on the inputbox above
FRow = Wk1.Cells.Find("66990000", lookat:=xlPart).Offset(2, 0).row
lRow = Wk1.Cells.Find("66990000", lookat:=xlPart).End(xlDown).Offset(-1, 0).row
ExpCol = Wk1.Cells.Find(Expense, lookat:=xlPart).Column
PropCodeCol = Wk1.Cells.Find("Property Code", lookat:=xlWhole).Column
'Defines the Range of the PM or Sub-Market Names
Dim OpsRg As Range
Set OpsRg = Wk1.Range(Wk1.Cells(FRow, OpsCol), Wk1.Cells(lRow, OpsCol))
'Defines the Range of the Property Codes
Dim PropCodeRg As Range
Set PropCodeRg = Wk1.Range(Wk1.Cells(FRow, PropCodeCol), Wk1.Cells(lRow, PropCodeCol))
'Defines the exact range of the expense column being analyzed
Dim ExpRg As Range
Set ExpRg = Wk1.Range(Wk1.Cells(FRow, ExpCol), Wk1.Cells(lRow, ExpCol))
End With
Dim AllEntRg As Range
For Each Cell In OpsRg
If Cell = "" Then
If AllEntRg Is Nothing Then
Set AllEntRg = Cells(Cell.row, PropCodeCol)
Else
Set AllEntRg = Union(AllEntRg, Cells(Cell.row, PropCodeCol))
End If
'End If
End If
Next
MsgBox (AllEntRg.Address)
'MsgBox (Application.Match(Wk1.Cells(59, 1), CCRg, 0))
'Dim y
'y = Application.Match(Wk1.Cells(10, 1), CCRg, 0)
'If IsError(y) Then
'MsgBox ("pooopy error")
'End If
Dim EntityRg As Range
'Dim c As Range
For Each c In AllEntRg
'Dim z
'z = Application.Match(c, CCRg, 0)
If CCRg.Find(c.Value, lookat:=xlPart) Is Nothing Then
If EntityRg Is Nothing Then
Set EntityRg = c
Else
Set EntityRg = Union(EntityRg, c)
End If
End If
Next
MsgBox (EntityRg.Address)
Dim CostCRg As Range
Dim r As Range
For Each r In AllEntRg
If Not CCRg.Find(r.Value, lookat:=xlPart) Is Nothing Then
If CostCRg Is Nothing Then
Set CostCRg = r
Else
Set CostCRg = Union(CostCRg, r)
End If
End If
Next
MsgBox (CostCRg.Address)
Dim v As Double
v = Application.WorksheetFunction.Sum(EntityRg)
'SendKeys "{F9}"
MsgBox (v)
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
I have no means of running your code but I have reviewed it and have noticed some possible problems.
lRowCC = Wk4.Cells.Find("Cost Center", lookat:=xlWhole).End(xlDown).row
`.End(xlDown) is not a reliable method of finding the last row of a column. Read this answer of mine for an explanation: Excel vba – xlDown
You say: “For EntityRg, the range.address defined is the same as AllEntRg (this shouldn't be the case).”
Do you believe they are the same because EntityRg.Address = AllEntRg.Address?
EntityRg .Address will be a string of absolute cell and range addresses separated by commas. You may not be aware that this string has a maximum length of about 255. I cannot find any documentation but from my own experimentation, EntityRg .Address will be truncated to less than 256 such that there is no partial cell or range address.
Are you being fooled by the first 255 characters of these addresses matching?
Another possibility is that every use of CCRg.Find(c.Value, lookat:=xlPart) returns Nothing so EntityRgand AllEntRg are equal. You say CostCRg gives an error; is this because it is Nothing?
You have two loops searching CCRg for values in AllEntRg. One loop records the successes and one records the failures. Why not combine the loops into something like:
If CCRg.Find(c.Value, lookat:=xlPart) Is Nothing Then
If EntityRg Is Nothing Then
Set EntityRg = c
Else
Set EntityRg = Union(EntityRg, c)
End If
Else
If CostCRg Is Nothing Then
Set CostCRg = r
Else
Set CostCRg = Union(CostCRg, r)
End If
End If
I am concerned that For Each c In AllEntRg is not giving you what you expect. If you combine ranges with Union, it will tidy them up. So Union(Range("A2"), Range("A3", Range("A5"), Range("A6"), Range("A7")).Address is
"$A$2:$A$3,$A$5:$A$7" not "$A$2,$A$3,$A$5,$A$6,$A$7". My recollection is that For Each c In AllEntRg would not split "$A$2:$A$3" into separate cells.
Please use F8 to step through this loop to check that it is performing as you expect.
Hope this helps
Answer to problem described in comment
Your problem is you are not being consistent in you use of Withs and, in particular, you are not identifying which workbook you want to operate on.
Wk4 is explicitly specified to be within workbook BufdWkb and Wk1 is specified to be within PNLWkb.
However, in
Set AllEntRg = Cells(Cell.row, PropCodeCol)
you do not specify a worksheet or workbook for Cells. This is the equivalent of
Set AllEntRg = ActiveWorkbook.ActiveSheet.Cells(Cell.row, PropCodeCol)`
You need to write Set AllEntRg = .Cells(Cell.row, PropCodeCol) (note period before Cells) and include this code within the With Wk1 Block.