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

[meho2020]

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:

 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

[Delaney]

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

[Delaney]

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

 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

[meho2020]

Dear Delany

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

[meho2020]

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:

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

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

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

Moheb Labib

[Delaney]

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.

[meho2020]

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

[Delaney]

see the other thread for the correction

regards