Delete Rows which values < 500 and Rounding Values > 500 VB.net?

Dear All

0


I have a Column in excel which has numbers with Decimals, Which if they are less than 500 I want to delete and if they are bigger than 500, i want to round the number to become without decimals.

I use the below code which does not give any errors but does not do the job, Please Check this Code:

Code:

---

Private Sub DeleteCells()
        Dim xl As New Excel.Application
        Dim wb As Excel.Workbook
        Dim ws As Excel.Worksheet
        Dim Rng As Excel.Range
        Dim i As Integer
        Dim currentcell As Excel.Range
        Dim lRow As Long
        xl.DisplayAlerts = False
        wb = xl.Workbooks.Open("C:\Patches\Main_Master_VB.xlsm")
        ws = wb.Sheets("Result_T08")
        With ws
            lRow = .Range("B" & .Rows.Count).End(Excel.XlDirection.xlUp).Row
        End With
        Rng = ws.Range("B2", "B" & lRow)
        For i = Rng.Rows.count To 1 Step -1
            If Rng.Cells(i).Value < 500 Then
                Rng.Rows(i).EntireRow.Delete
            Else
                For Each currentcell In Rng
                    currentcell.Value = xl.WorksheetFunction.Round(currentcell.Value, 0)
                Next currentcell
            End If
        Next i
        xl.DisplayAlerts = True
    End Sub

---

Your help is Highly Appreciated, Thanks

Moheb Labib

Hello,

the problem is when you delete a row, you shift the next value to the previous row, so you miss the row shifted and so on.

the best would be to do the loop in reverse. I am working on it

here is the solution, and please, set option strict to ON

Code:

---

Private Sub DeleteCells(ByVal path As String)
      Dim xl As New Excel.Application
      Dim wb As Excel.Workbook
      Dim ws As Excel.Worksheet
      Dim Rng As Excel.Range
      Dim lRow As Integer

      wb = xl.Workbooks.Open(path)
      ws = CType(wb.Sheets("Feuil1"), Excel.Worksheet)
      With ws
        lRow = .Range("B" & .Rows.Count).End(Excel.XlDirection.xlUp).Row
      End With
      Rng = ws.Range("B2", "B" & lRow)

     
      For i = lRow To 1 Step -1
        Dim line As Excel.Range
        line = CType(Rng.Cells(i, 1), Excel.Range) 'you must place the CType in a variable then use it else you will have an error
        If CDbl(line.Value) < 500 Then
            line.EntireRow.Delete()
        Else
            line.Value = xl.WorksheetFunction.Round(CDbl(line.Value), 0)
        End If

      Next
      wb.Close(SaveChanges:=True)
      xl.Quit()

  End Sub

---

of course the file must be close.... else see the others threads you start to deal with open file

regards

Dear Delany

The Line Idea is Brilliant, The Code Works Perfectly, Thanks a Lot

Dear Delany

I need your support in the following code which I use to Split One excel Sheet into many sheets according to the Criteria (Diameter), the Code I am using in VBA is working but in VB.net It is not working, the VB Code is as below:

Code:

---

Private Sub Splitter()
        Dim xl As New Excel.Application
        Dim wb As Excel.Workbook
        Dim Source As Excel.Worksheet
        Dim Destination As Excel.Worksheet
        Dim SourceRow As Long
        Dim Lastrow As Long
        Dim DestinationRow As Long
        Dim Diameter As String
        xl.Application.ScreenUpdating = False
        wb = xl.Workbooks.Open("C:\Patches\Main_Master_VB.xlsm")
        Source = CType(wb.Worksheets("Master"), Excel.Worksheet)
        Dim RowCount = Source.Rows.Count
        Dim LastRowRange = CType(Source.Cells(RowCount, "C"), Excel.Range)
        Lastrow = LastRowRange.End(Excel.XlDirection.xlUp).Row
        For SourceRow = Lastrow To 2 Step -1
            Dim DiameterRange = CType(Source.Cells(SourceRow, "C"), Excel.Range)
            Diameter = DiameterRange.Value.ToString
            Destination = Nothing
            On Error Resume Next
            Destination = CType(wb.Sheets(Diameter), Excel.Worksheet) 'Error Invalid Index
            On Error GoTo 0
            If Destination Is Nothing Then
                Destination = CType(wb.Worksheets.Add(After:=wb.Worksheets(wb.Worksheets.Count)), Excel.Worksheet)
                Destination.Name = Diameter
                Dim row = CType(Source.Rows(1), Excel.Range)
                row.Copy(Destination.Rows(1))
            End If
            Dim DestinationRowRange = CType(Destination.Cells(Destination.Rows.Count, "C"), Excel.Range)
            DestinationRow = DestinationRowRange.End(Excel.XlDirection.xlUp).Row + 1
            Dim SourceRowRange = CType(Source.Rows(SourceRow), Excel.Range)
            SourceRowRange.Copy(Destination:=Destination.Rows(DestinationRow))
        Next SourceRow
        xl.Application.ScreenUpdating = True
        wb.Close(SaveChanges:=vbTrue)
        xl.Quit()
    End Sub

---

It gives me Error : Invalid Index on the line

Code:

---

Destination = CType(wb.Sheets(Diameter), Excel.Worksheet)

---

Can you tell me, How I can fix it, Thanks a Lot

Moheb Labib

That's a new subject and you already started a thread about it so update the other thread with you modification and new error, not this one.
I will have a look to it.

Dear Delany

it is there under the name:
How to Split One Excel Sheet into many Sheets According to its Criteria?
Thanks a lot
Moheb Labib

see the other thread for the correction

regards