VBA Deleting rows by found cell values - excel

I have this code and i want to delete all rows by cell value which contain "BSB*" (so there are values like BSB 1, 2 etc) this code works partially. It deletes only every second cell which contain BSB. So i have BSB 2, 4 etc. I want to delete all rows where value BSB is present in speecific column ofc.
p.s english is my second language so please let mi know if i need to clarify something
Option Explicit
Sub PrList()
Dim wb As Workbook
Dim ws As Worksheet
Dim r As Range
Dim i As Range
Set wb = Workbooks.Open("?????")
Set ws = wb.Worksheets("owssvr")
With ws.Range("A1").CurrentRegion
.Find(What:="Product_Number", LookAt:=xlWhole).Name = "Product_Number"
.Find(What:="Product_Status", LookAt:=xlWhole).Name = "Product_Status"
.Find(What:="Group_of_product", LookAt:=xlWhole).Name = "Group_of_product"
End With
Set i = ws.Range("Product_Number", Range("Product_Number").End(xlDown))
For Each r In i
If r Like "BSB*" Then
r.Rows.Delete
End If
Next r
End Sub

Try this
Option Explicit
Sub NAPP_PrList()
Dim wb As Workbook
Dim ws As Worksheet
Dim r As Range
Dim i As Range
Dim j as Long
Set wb = Workbooks.Open("?????")
Set ws = wb.Worksheets("owssvr")
With ws.Range("A1").CurrentRegion
.Find(What:="Product_Number", LookAt:=xlWhole).Name = "Product_Number"
.Find(What:="Product_Status", LookAt:=xlWhole).Name = "Product_Status"
.Find(What:="Group_of_product", LookAt:=xlWhole).Name = "Group_of_product"
End With
Set i = ws.Range("Product_Number", Range("Product_Number").End(xlDown))
For j = i.Rows.Count To 1 Step -1
If i(j, 1) Like "BSB*" Then i(j, 1).EntireRow.Delete
Next
End Sub

Related

VBA code working when I step through it, but not when it's run

I have some basic VBA that is allowing a user to take a field from one table and use it to update another table. It works fine when I step through it, but nothing happens when I run it using F5. I don't get any errors, just nothing happens.
I think it could possibly be that the value hasn't been assigned to one of the variables before the next step occurs, but I've never had that problem before, and I've always assumed VBA wouldn't move to the next step until it had completed the one it's on?
My code is below:
Option Explicit
Sub acceptDateComp()
'set data type
Dim dtType As String
dtType = "opportunity"
'declare sheets
Dim wsComp As Worksheet
Set wsComp = ThisWorkbook.Sheets(dtType & "Comp")
Dim wsBCE As Worksheet
Set wsBCE = ThisWorkbook.Sheets(dtType & "Snapshot")
Dim wsOffline As Worksheet
Set wsOffline = ThisWorkbook.Sheets(dtType & "Database")
'declare tables
Dim bce As ListObject
Set bce = wsBCE.ListObjects(dtType & "Snapshot")
Dim offline As ListObject
Set offline = wsOffline.ListObjects(dtType & "Database")
Dim dateComp As ListObject
Set dateComp = wsComp.ListObjects(dtType & "DateComp")
'declare heights and areas
Dim offlineRange As Range
Set offlineRange = offline.ListColumns(1).DataBodyRange
'check for acceptance, then change values
Dim i As Long
Dim dateID As Long
Dim offlineRow As Long
Dim bceDate As String
For i = 2 To dateComp.ListRows.Count + 1
If dateComp.ListColumns(6).Range(i).Value = "Yes" Then
dateID = dateComp.ListColumns(1).Range(i).Value
offlineRow = Application.WorksheetFunction.Match(dateID, offlineRange, 0)
bceDate = dateComp.ListRows(i - 1).Range(5).Value
offline.ListRows(offlineRow).Range(12).Value = bceDate
End If
Next i
Call opportunityComp
End Sub

Is there a way to reassign a Range variable to a different range?

I am very new to VBA, having started programming it yesterday. I am writing a data processing program which requires keeping track of two cells, one on each spreadsheet. The code which reproduces the errors I am experiencing is below. When I call the sub moveCell() in sub Processor(), nothing happens to DIRow and DIColumn, and the code spits out error 1004 at the line indicated. I have tried using DICell = DICell.Offset(), but it returns the same error.
How can I redefine a Range variable to be a different cell?
'<<Main Processor Code>>'
Sub Processor()
Dim PDRow As Integer
Dim PDColumn As Integer
Dim DIRow As Integer
Dim DIColumn As Integer
PDRow = 1
PDColumn = 1
DIRow = 1
DIColumn = 1
Dim PDCell As Range
Dim DICell As Range
Set PDCell = Worksheets("Processed Data").Cells(PDRow, PDColumn)
Set DICell = Worksheets("Data Input").Cells(DIRow, DIColumn)
Call moveCell(2, 0, "Data Input")
End Sub
'<<Function which moves the cell which defines the range>>'
Sub moveCell(r As Integer, c As Integer, sheet As String)
If sheet = "Processed Data" Then
PDRow = PDRow + r
PDColumn = PDColumn + c
Set PDCell = Worksheets("Data Input").Cells(PDRow, PDColumn)
ElseIf sheet = "Data Input" Then
DIRow = DIRow + r '<<<<<<This line does nothing to DIRow's value
DIColumn = DIColumn + c
Set DICell = Worksheets("Data Input").Cells(DIRow, DIColumn) '<<<<<<This line causes error 1004
End If
End Sub
As far as I can tell, you could instead use a quick Function instead. There doesn't seem to be any difference in your If statement results in the moveCell() function, except which worksheet you're using.
We can make this simpler by referring to the Range you're passing to moveCell.
Option Explicit ' forces you to declare all variables
Sub something()
Dim PDCell As Range
Set PDCell = Worksheets("Processed Data").Cells(1, 1)
Dim DICell As Range
Set DICell = Worksheets("Data Input").Cells(1, 1)
PDCell.Select ' can remove
Set PDCell = moveCell(2, 0, PDCell, PDCell.Worksheet.Name)
PDCell.Select ' can remove
Worksheets(DICell.Worksheet.Name).Activate ' can remove
DICell.Select ' can remove
Set DICell = moveCell(5, 0, DICell, DICell.Worksheet.Name)
DICell.Select ' can remove
End Sub
Function moveCell(rowsToMove As Long, colsToMove As Long, cel As Range, ws As String) As Range
Set moveCell = Worksheets(ws).Cells(cel.Row + rowsToMove, cel.Column + colsToMove)
End Function
I've included some rows you don't need (which I've marked with a comment afterwards), but that will show you how the routine works. You can step through with F8 to help see it step-by-step.
Edit: Although, you don't need a separate function at all. Just use OFFSET().
Set PDCell = ...whatever originally
Set PDCell = PDCell.Offset([rows],[cols])

VBA Copying Excel Range to Different Workbook

I am trying to find a way to copy a range in one workbook, in this case A6:J21,to another workbook. I thought it would be something like the following...
currentWorksheet = xlWorkBook.Sheets.Item("Command Group")
excelRange = currentWorksheet.Range("A6:J21")
excelDestination = newXlSheet.Range("A6:J21")
excelRange.Copy(excelDestination)
But it gives me an error on excelRange.Copy(excelDestination).
The below code runs as expected, so I'm not sure where i'm going wrong here..
Dim xRng As Excel.Range = CType(currentWorksheet.Cells(7, 7), Excel.Range)
Console.WriteLine(xRng.ToString)
Dim val As Object = xRng.Value()
testString = val.ToString
Console.WriteLine(testString)
newXlSheet.Cells(1, 1) = testString
To answer your question "Why is B running, but not A"..
In A:
currentWorksheet = xlWorkBook.Sheets.Item("Command Group")
First, you are missing SET for your object assignment. Secondly, you are using Workbook.Sheets.Item() which returns a Sheets object. A Sheets object can represent either a chart sheet, or a work sheet, and therefore does not have a .Range() method.
You can verify this by stepping over this code:
Dim currentWorksheet As Sheets
Set currentWorksheet = ThisWorkbook.Sheets.Item("Command Group")
excelRange = currentWorksheet.Range("A1:A21")
It will error, and tell you that the method is not found.
To Fix A: Ensure you get back a Worksheet object by using strong typing.
Dim currentWorksheet as Worksheet
Set currentWorksheet = ThisWorkbook.Sheets.Item("Command Group")
To fix future code and ease the debugging process I highly recommend always declaring Option Explicit at the top of all your modules.
For brevity you can shorten your code to:
Dim currentWorksheet as Worksheet
Set currentWorksheet = ThisWorkbook.Sheets("Command Group")
This should do it, let me know if you have trouble with it:
Sub foo()
Dim x As Workbook
Dim y As Workbook
'## Open both workbooks first:
Set x = Workbooks.Open(" path to copying book ")
Set y = Workbooks.Open(" path to destination book ")
'Now, copy what you want from x:
x.Sheets("name of copying sheet").Range("A1").Copy
'Now, paste to y worksheet:
y.Sheets("sheetname").Range("A1").PasteSpecial
'Close x:
x.Close
End Sub
Alternatively, you could just:
Sub foo2()
Dim x As Workbook
Dim y As Workbook
'## Open both workbooks first:
Set x = Workbooks.Open(" path to copying book ")
Set y = Workbooks.Open(" path to destination book ")
'Now, transfer values from x to y:
y.Sheets("sheetname").Range("A1").Value = x.Sheets("name of copying sheet").Range("A1")
'Close x:
x.Close
End Sub
Copy from one workbook and paste into another
Refer to the below code to copy data from one worksheet(say file1) to the other(say file2). I created this file to avoid copying formats from the other workbook as it was causing the file(say file1) to crash. The intention is to copy only values cell by cell from one sheet to another sheet.
Sub Copydatafrom_sheets()
'This will copy sheet cell by cell without selecting the cells.
'commented items are not used in the code execution
Dim i As Long
Dim j As Long
i = 1
j = 1
Application.ScreenUpdating = False
Dim file1 As Workbook ' defined as workbook
Dim file2 As Workbook ' defined as workbook
Dim range1 As Range
Dim range2 As Range ' not used
Dim Copied_data As String ' to store data in this string while iterating
Set file1 = Workbooks.Open("G:\MyProject - Backup\QAQC\Data Combined - 2.xlsx") ' file where orinal data is stored, use your own file names
Set file2 = Workbooks.Open("G:\MyProject - Backup\QAQC\Test3.xlsm") ' File where it shall be copied
Set range1 = file1.Sheets("ASC_Table_1").Range("A1:V25944") 'set the range to be copied
For Each cell In range1
Copied_data = file1.Sheets("ASC_Table_1").Cells(i, j).Value
'MsgBox (Copied_data)
file2.Sheets("Sheet2").Cells(i, j) = Copied_data
If j <= 22 Then j = j + 1
If j > 22 Then
i = i + 1
j = 1
End If
Application.StatusBar = Format((i / 25994), "Percent")
Next
Application.ScreenUpdating = True
file2.Save 'Optional
End Sub

Runtime Error 9 on Loop

I have three workbooks; all with information on the same policies, but come from different documents. I'm trying to copy the value of the same cell from each worksheet that has the same worksheet name in workbooks 1 & workbook 3. This is the code that I have:
Sub foo()
Dim wbk1 As Workbook
Dim wbk2 As Workbook
Dim wkb3 As Workbook
Dim shtName As String
Dim i As Integer
Set wkb1 = Workbooks.Open("C:\Users\lliao\Documents\Trad Reconciliation.xlsx")
Set wkb2 = Workbooks.Open("C:\Users\lliao\Documents\TradReconciliation.xlsx")
Set wkb3 = Workbooks.Open("C:\Users\lliao\Documents\Measure Trad Recon LS.xlsx")
shtName = wkb2.Worksheets(i).Name
For i = 2 To wkb2.Worksheets.Count
wkb2.Sheets(shtName).Range("D3").Value = wkb1.Sheets(shtName).Range("D2")
wkb2.Sheets(shtName).Range("E3").Value = wkb1.Sheets(shtName).Range("E2")
wkb2.Sheets(shtName).Range("F3").Value = wkb1.Sheets(shtName).Range("F2")
wkb2.Sheets(shtName).Range("D4").Value = wkb3.Sheets(shtName).Range("D2")
wkb2.Sheets(shtName).Range("E4").Value = wkb3.Sheets(shtName).Range("E2")
wkb2.Sheets(shtName).Range("F4").Value = wkb3.Sheets(shtName).Range("F2")
Next i
End Sub
I don't understand how I'm using the subscript wrong. This is my first time coding VBA (first time in 5+ years), so I'm unfamiliar with coding errors.
Thank you!
Dim i As Integer
Set wkb1 = Workbooks.Open("C:\Users\lliao\Documents\Trad Reconciliation.xlsx")
Set wkb2 = Workbooks.Open("C:\Users\lliao\Documents\TradReconciliation.xlsx")
Set wkb3 = Workbooks.Open("C:\Users\lliao\Documents\Measure Trad Recon LS.xlsx")
shtName = wkb2.Worksheets(i).Name
Variable i is declared, but used before it's assigned - its value is therefore an implicit 0.
With VBA collections being 1-based, that makes wkb2.Worksheets(i) be out of bounds.
Dim i As Integer
i = 1
'...
shtName = wkb2.Worksheets(i).Name
Will fix it.
You probably want to move it inside the loop though.
may be you're after this:
For i = 2 To wkb2.Worksheets.Count
wkb2.Sheets(i).Range("D3:F3").Value = wkb1.Sheets(i).Range("D2:F2")
wkb2.Sheets(i).Range("D4:F4").Value = wkb3.Sheets(i).Range("D2:F2")
Next i

Sum using Index vba excel

Can someone tell me the correct syntax for this code I am trying to execute? From a 1D range of string values, I want to pick a certain string say "this" and calculate the sum of all the values of "this" which are displayed in the immediate next column. It's been eating my head up for hours. And also, is there another better way to do it?
With Application.WorksheetFunction
Range("AA2").Value = .Sum(.Index(ws(1).Range("F8"), .Match(ws(1).Range("AA1"), ws(1).Range("E8:E16"), 0), 0) **:** .index(ws(1).Range("F16"), .Match(ws(1).Range("AA1"), ws(1).Range("E8:E16"), 0), 0)
End With
In excel it would be:
=SUMIF(E8:E16,"=this",F8:F16)
So in your macro try:
Option Explicit
Public Sub StackOverflowDemo()
Dim conditionText As String
Dim ws As Worksheet
Dim target As Range
Dim sourceCriteria As Range
Dim sourceSum As Range
Set ws = ThisWorkbook.Sheets(1)
conditionText = "this"
Set target = ws.Range("AA2")
Set sourceCriteria = ws.Range("E8:E16")
'the above stuff would probably be passed as parameters since I doubt you want that stuff hard coded
'from here on there's no hard coding.
Set sourceSum = sourceCriteria.Offset(0, 1)
target.Value = WorksheetFunction.SumIf(sourceCriteria, "=" & conditionText, sourceSum)
End Sub
Update: Refactored to show the reusability / benefit of using variables:
Option Explicit
Public Sub StackOverflowDemo()
Dim ws As Worksheet
Set ws = ThisWorkbook.Sheets(1)
DoSumIf ws.Range("E8:E16"), "this", ws.Range("AA2")
DoSumIf ws.Range("E8:E16"), "that", ws.Range("AA3")
DoSumIf ws.Range("B2:B32"), "who", ws.Range("AA4")
End Sub
Private Sub DoSumIf(sourceCriteria As Range, conditionText As String, target As Range)
Dim sourceSum As Range
Set sourceSum = sourceCriteria.Offset(0, 1)
target.Value = WorksheetFunction.SumIf(sourceCriteria, "=" & conditionText, sourceSum)
End Sub
You can do it in VBA using something to this effect:
This will search E2:E300 for the string "P09" and sum the column directly to the right.
Sub Test123455()
Dim MyRange As Range
Set MyRange = Nothing
Dim curcell As Range
For Each curcell In Range("E2:E300")
If InStr(1, curcell.Value, "P09", vbTextCompare) > 0 Then
If MyRange Is Nothing Then
Set MyRange = curcell
Else
Set MyRange = Union(MyRange, curcell.Offset(0, 1))
End If
End If
Next curcell
MsgBox Application.WorksheetFunction.Sum(MyRange)
End Sub

Resources