Need VBA Code to Copy Predefined Text for each one IPv4 Address that can be found in 1st Sheet - Remove Not Valid IPv4 data

dvampoulis

New Member
Joined
Feb 13, 2021
Messages
9
Office Version
  1. 365
  2. 2019
  3. 2016
  4. 2013
Platform
  1. Windows
Hello Dear Excel Users,

I Am trying long time ago now to implement an XLSM file that Will create a script for creating LSPs for my LAB (Routers)

The XLSM view is as above

XLSM Data Entry Page.jpg


Actually in 1st XLSM Sheet Columns (A,B,C,D,E,F,G,H,I.J,K) are the data entered from another XLS and with colors (are being verified with conditional formating that are correct.

On Columns (M,N,O.P) are only the IPv4 addresses that will be used on the next part so to create a CLI script (for creating the LSPs in my LAB)

The case is that i nead for each one cell of Columns (M,O) that containts an IPv4 like (172.17.x.x) a predifined CLI code to be writen to another sheet of XLSM by adding this IPv4 Address. (See example bellow).

Example for 3xIP addresses found on Columns (M,O) it should create 7xLine code (Starting from MACRO_TE_TUNNEL_PATH_HOP NoCmd_TE_TUNNEL_PATH_HOP) and Ending in "ENDM" by adding also the IPv4 address at field "NEXT_HOP_IP = 172.17.X.X" (See example bellow).

XLSM LSP Creation Page 1 (OK).jpg


The problem is that since on the 1st image as you can see some IPv4 addresses will be Null (No data) so VBA should delete 7x Lines CLI code for each one that will not find an IPv4 address (See example bellow - XLSM lines from 151 to 157 should be removed from VBA since no Valid IPv4 address found).

XLSM LSP Creation Page 1 (Not-OK #2).jpg


Could you please help me? I am really stacked!

Actually the needed VBA code should find from Sheet named as "XXX" the field that contains null IPv4 address "NEXT_HOP_IP = " delete it and also delete 3x Rows above and 3x Rows bellow

I found some other code (like the above) but i cannot make it work as i cannot filter and separate the wording "NEXT_HOP_IP = " with the "NEXT_HOP_IP = 172.17.x.x"

Your help is really appreciated.

Scenario1 (not match my needs - but is close relative):

Sub deleteRows()
'
' deleteRows Macro
'
' Keyboard Shortcut: Ctrl+s
'
Dim StartRange As String
Dim EndRange As String
Cells.Find(What:="NEXT_HOP_IP = ").Select
StartRange = ActiveCell.Address
EndRange = ActiveCell.Address & 4
ActiveSheet.Range(StartRange & ":" & EndRange).Select
Selection.Delete Shift:=xlUp

End Sub

Scenario2 (not match my needs - but is close relative):

Sub Delete_Rows()

Dim xRow As Integer
Dim strSearch As String

strSearch = "NEXT_HOP_IP = "
' Assuming Total is in column A as your picture shows, but you can configure to search anywhere

xRow = Range("A" & Rows.Count).End(xlUp).Row
Range("$A1:C" & xRow).Select

Selection.find(What:=strSearch, After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Select

Range(ActiveCell.Row & ":" & ActiveCell.Offset(-3, 0).Row).Select
Selection.Delete Shift:=xlUp

End Sub

Scenario3 (not match my needs - but is close relative):

Sub DeleteRows()
Dim last As Long
Dim i As Long
With ActiveSheet
last = .Cells(.Rows.Count, 1).End(xlUp).Row
For i = last To 1 Step -1 'Changed that from the original code!!!
If .Cells(i, 1).Value Like "NEXT_HOP_IP = 172*" Then
.Cells(i - 7, 1).Resize(6, 1).EntireRow.Delete
End If
Next i
End With
End Sub

Scenario4 (not match my needs - but is close relative):

Sub test()

Dim currentSht As Worksheet
Dim startCell As Range
Dim lastRow As Long
Dim lastCol As Long
Dim i as integer

Set currentSht = ActiveWorkbook.Sheets(1)

Set startCell = currentSht.Range("A1")
lastRow = startCell.SpecialCells(xlCellTypeLastCell).Row
lastCol = startCell.SpecialCells(xlCellTypeLastCell).Column

For i = lastRow To 1 Step - 1
If Cells(i, "B").Value <> "NEXT_HOP_IP = 172.17*" Then
Range(Cells(i, "B").Offset(1), Cells(i, "B").Offset(2)).EntireRow.Delete 'delete two below
Cells(i, "B").Offset(-1).EntireRow.Delete ' delete one above


End Sub

Scenario5 (not match my needs - but is close relative):

Sub Delete_Rows_Based_On_Criteria()

Dim newUpRow, newDownRow As Integer

Range("A1").Select
Cells.Find(What:="NEXT_HOP_IP = 172.17*", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False).Activate

newUpRow = ActiveCell.Row - 3
Rows(newUpRow).Delete shift:=xlUp

newDownRow = ActiveCell.Row + 3
Rows(newDownRow).Delete shift:=xlUp

End Sub

Scenario6 (not match my needs - but is close relative):

Sub DeleteSuccessfulRows()

Application.ScreenUpdating = False
Dim x
For x = Cells(Rows.Count, ActiveCell.Column).End(xlUp).Row To ActiveCell.Row Step -1
If Cells(x, 1) = "NEXT_HOP_IP = " Then 'If we find this text
Cells(x, 1).EntireRow.Delete 'Delete the entire row
Cells(x - 3, 1).EntireRow.Delete 'Delete the row 3 rows bellow it
Cells(x - 3, 1).EntireRow.Delete 'Delete the row 3 rows above it
x = x - 2
'Delete blank rows
ElseIf Cells(x, 1) = vbNullString Then Cells(x, 1).EntireRow.Delete
'Optional delete rows that contain "File looks like ..."
'ElseIf Cells(x, 1) = "File looks like it is not encrypted. Skipping ..." Then Cells(x, 1).EntireRow.Delete
'ElseIf Cells(x, 1) = "File could not be decrypted properly. Skipping ..." Then Cells(x, 1).EntireRow.Delete
End If
Next x
Application.ScreenUpdating = True

End Sub

------------


At your disposal,

Kind Regards,

Dimitris.
 

Tupe77

Board Regular
Joined
Nov 26, 2020
Messages
97
Office Version
  1. 365
  2. 2016
Platform
  1. Windows
This macro should work reasonably quickly.
The macro works on the Active Sheet, in columns A to C. Please check that Columns are correct for your sheet.
Since there was no model where I could have tried the operation of the macro with real data, PLEASE BACK UP THE WORKBOOK!

This requires that the rows to be deleted in the different columns cannot overlap!
I mean that cells A20 and C25 cannot have "NEXT_HOP_IP =", in which case the same row will be deleted twice (rows 22,23) and it will not succeed.

VBA Code:
Sub TS_Delete_Rows()
' ***** FOR ERROR HANDLING ****************************************
On Error GoTo ErrHand: Application.Calculation = xlManual: Application.ScreenUpdating = False: Application.DisplayAlerts = False

Dim coT As Single: coT = Timer()
Dim LastRow As Long, SeaLenghtINT As Integer
Dim SeaRNG As Range
Dim Arr As Variant, RowArr As Variant
Dim SeaSTR As String, ValToTest As String, RowSTR As String

SeaLenghtINT = 14                               ' String lenght to search
SeaSTR = "NEXT_HOP_IP = "                       ' String to search

LastRow = Range("A" & Rows.Count).End(xlUp).Row ' CHECK THAT COLUMN LETTER IS CORRECT!
Set SeaRNG = Range("$A1:C" & LastRow)           ' CHECK THAT COLUMNS LETTERS ARE CORRECT! DO NOT CHANGE ROW NUMBER!

Arr = SeaRNG.Value
' Search for SeaSTR
Dim i As Long, j As Long
For i = LBound(Arr) To UBound(Arr)
    For j = LBound(Arr, 2) To UBound(Arr, 2)
        ValToTest = Arr(i, j)
        If InStr(ValToTest, SeaSTR) > 0 And Len(ValToTest) <= SeaLenghtINT Then
            RowSTR = RowSTR & i & ","
        End If
    Next j
Next i

' Creating Array for Rows to Delete
RowArr = Split(Left(RowSTR, Len(RowSTR) - 1), ",")

' Deleting Rows
For i = UBound(RowArr) To LBound(RowArr) Step -1
    SeaRNG.Rows(RowArr(i) - 3 & ":" & RowArr(i) + 3).EntireRow.Delete
Next i

Debug.Print Timer() - coT ' Timer end
ErrHand:
Application.Calculation = xlAutomatic: Application.ScreenUpdating = True: Application.DisplayAlerts = True
If Err.Number <> 0 Then MsgBox "Something went badly wrong!" & vbCrLf & "VBA-code is ended!" & vbCrLf & vbCrLf & "Error number: " & Err.Number & " " & Err.Description: End

End Sub
 
Last edited:

Excel Facts

Add Bullets to Range
Select range. Press Ctrl+1. On Number tab, choose Custom. Type Alt+7 then space then @ sign (using 7 on numeric keypad)

dvampoulis

New Member
Joined
Feb 13, 2021
Messages
9
Office Version
  1. 365
  2. 2019
  3. 2016
  4. 2013
Platform
  1. Windows
This macro should work reasonably quickly.
The macro works on the Active Sheet, in columns A to C. Please check that Columns are correct for your sheet.
Since there was no model where I could have tried the operation of the macro with real data, PLEASE BACK UP THE WORKBOOK!

This requires that the rows to be deleted in the different columns cannot overlap!
I mean that cells A20 and C25 cannot have "NEXT_HOP_IP =", in which case the same row will be deleted twice (rows 22,23) and it will not succeed.

VBA Code:
Sub TS_Delete_Rows()
' ***** FOR ERROR HANDLING ****************************************
On Error GoTo ErrHand: Application.Calculation = xlManual: Application.ScreenUpdating = False: Application.DisplayAlerts = False

Dim coT As Single: coT = Timer()
Dim LastRow As Long, SeaLenghtINT As Integer
Dim SeaRNG As Range
Dim Arr As Variant, RowArr As Variant
Dim SeaSTR As String, ValToTest As String, RowSTR As String

SeaLenghtINT = 14                               ' String lenght to search
SeaSTR = "NEXT_HOP_IP = "                       ' String to search

LastRow = Range("A" & Rows.Count).End(xlUp).Row ' CHECK THAT COLUMN LETTER IS CORRECT!
Set SeaRNG = Range("$A1:C" & LastRow)           ' CHECK THAT COLUMNS LETTERS ARE CORRECT! DO NOT CHANGE ROW NUMBER!

Arr = SeaRNG.Value
' Search for SeaSTR
Dim i As Long, j As Long
For i = LBound(Arr) To UBound(Arr)
    For j = LBound(Arr, 2) To UBound(Arr, 2)
        ValToTest = Arr(i, j)
        If InStr(ValToTest, SeaSTR) > 0 And Len(ValToTest) <= SeaLenghtINT Then
            RowSTR = RowSTR & i & ","
        End If
    Next j
Next i

' Creating Array for Rows to Delete
RowArr = Split(Left(RowSTR, Len(RowSTR) - 1), ",")

' Deleting Rows
For i = UBound(RowArr) To LBound(RowArr) Step -1
    SeaRNG.Rows(RowArr(i) - 3 & ":" & RowArr(i) + 3).EntireRow.Delete
Next i

Debug.Print Timer() - coT ' Timer end
ErrHand:
Application.Calculation = xlAutomatic: Application.ScreenUpdating = True: Application.DisplayAlerts = True
If Err.Number <> 0 Then MsgBox "Something went badly wrong!" & vbCrLf & "VBA-code is ended!" & vbCrLf & vbCrLf & "Error number: " & Err.Number & " " & Err.Description: End

End Sub
Wow man!!! I am ready impresses about your VBA :). I Put your VBA Code in a Macro and it needs only 3 Minutes (instaed 0f 6-7 approximately minutes that needed my old script). I am OK with that time taking into account that it handled about 20.000 rows and will finally cut near 14.000 lines (also my PC is not quite new so the delay think that is OK)

Taking into account that on my old VBA Code i am unhiding a sheet named as "LSP Macro FWD" doing in that Sheed the job o deletion and afterwards takind the final printout copying into another sheet named as CLI Notepad. Then i am hiding again sheet named as "LSP Macro FWD" so not to confuses me.

Is there any possibility of helping me to add the particular code under your VBA approach ? I tried to add the bellow commnads that i am using in my script but is appared an message and scrpt cannot run.

VBA Code:
'In the start
Application.ScreenUpdating = False
Sheets("LSP Macro FWD").Visible = True

'In the end:

VBA Code:
Call Clear_NotePad_For_CLI


    Sheets("LSP Macro FWD").Select
    Range("A1:A20500").Select
    Selection.Copy
    Sheets("NotePad For CLI").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False

Sheets("LSP Macro FWD").Visible = False
Application.ScreenUpdating = True


Sheets("NotePad For CLI").Select
Columns("A:A").Select
Selection.SpecialCells(xlCellTypeBlanks).Select
Selection.EntireRow.Delete
Range("A1").Select

Thanks again for your help man,

I really appreciate.

Kind Regards,

Dimitris Vampoulis
 

Tupe77

Board Regular
Joined
Nov 26, 2020
Messages
97
Office Version
  1. 365
  2. 2016
Platform
  1. Windows
"Application.ScreenUpdating = False" is already in the original macro in the "On Error GoTo" line and will be put back on in the "ErrHand:" line.

Sheets ("LSP Macro FWD"). Range ("A1: A20500") is copied -> Sheets ("NotePad For CLI") Range ("A1: A20500")
I wish I understand it right?

VBA Code:
Sub TS_Delete_Rows_V2()

Sheets("LSP Macro FWD").Visible = True ' This is not needed for running this VBA -code
' ***** FOR ERROR HANDLING ****************************************
On Error GoTo ErrHand: Application.Calculation = xlManual: Application.ScreenUpdating = False: Application.DisplayAlerts = False

Dim coT As Single: coT = Timer()
Dim LastRow As Long, SeaLenghtINT As Integer
Dim SeaRNG As Range
Dim Arr As Variant, RowArr As Variant
Dim SeaSTR As String, ValToTest As String, RowSTR As String

Sheets("LSP Macro FWD").Visible = True

SeaLenghtINT = 14                               ' String lenght to search
SeaSTR = "NEXT_HOP_IP = "                       ' String to search

LastRow = Range("A" & Rows.Count).End(xlUp).Row ' CHECK THAT COLUMN LETTER IS CORRECT!
Set SeaRNG = Range("$A1:C" & LastRow)           ' CHECK THAT COLUMNS LETTERS ARE CORRECT! DO NOT CHANGE ROW NUMBER!

Arr = SeaRNG.Value
' Search for SeaSTR
Dim i As Long, j As Long
For i = LBound(Arr) To UBound(Arr)
    For j = LBound(Arr, 2) To UBound(Arr, 2)
        ValToTest = Arr(i, j)
        If InStr(ValToTest, SeaSTR) > 0 And Len(ValToTest) <= SeaLenghtINT Then
            RowSTR = RowSTR & i & ","
        End If
    Next j
Next i

' Creating Array for Rows to Delete
RowArr = Split(Left(RowSTR, Len(RowSTR) - 1), ",")

' Deleting Rows
For i = UBound(RowArr) To LBound(RowArr) Step -1
    SeaRNG.Rows(RowArr(i) - 3 & ":" & RowArr(i) + 3).EntireRow.Delete
Next i


Sheets("NotePad For CLI").Range("A1:A20500").Value = Sheets("LSP Macro FWD").Range("A1:A20500").Value
Sheets("LSP Macro FWD").Visible = False ' This is not needed for running this VBA -code
Sheets("NotePad For CLI").Columns("A:A").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
Sheets("NotePad For CLI").Range("A1").Select

Debug.Print Timer() - coT ' Timer end
ErrHand:
Application.Calculation = xlAutomatic: Application.ScreenUpdating = True: Application.DisplayAlerts = True
If Err.Number <> 0 Then MsgBox "Something went badly wrong!" & vbCrLf & "VBA-code is ended!" & vbCrLf & vbCrLf & "Error number: " & Err.Number & " " & Err.Description: End

End Sub
 

dvampoulis

New Member
Joined
Feb 13, 2021
Messages
9
Office Version
  1. 365
  2. 2019
  3. 2016
  4. 2013
Platform
  1. Windows
"Application.ScreenUpdating = False" is already in the original macro in the "On Error GoTo" line and will be put back on in the "ErrHand:" line.

Sheets ("LSP Macro FWD"). Range ("A1: A20500") is copied -> Sheets ("NotePad For CLI") Range ("A1: A20500")
I wish I understand it right?

VBA Code:
Sub TS_Delete_Rows_V2()

Sheets("LSP Macro FWD").Visible = True ' This is not needed for running this VBA -code
' ***** FOR ERROR HANDLING ****************************************
On Error GoTo ErrHand: Application.Calculation = xlManual: Application.ScreenUpdating = False: Application.DisplayAlerts = False

Dim coT As Single: coT = Timer()
Dim LastRow As Long, SeaLenghtINT As Integer
Dim SeaRNG As Range
Dim Arr As Variant, RowArr As Variant
Dim SeaSTR As String, ValToTest As String, RowSTR As String

Sheets("LSP Macro FWD").Visible = True

SeaLenghtINT = 14                               ' String lenght to search
SeaSTR = "NEXT_HOP_IP = "                       ' String to search

LastRow = Range("A" & Rows.Count).End(xlUp).Row ' CHECK THAT COLUMN LETTER IS CORRECT!
Set SeaRNG = Range("$A1:C" & LastRow)           ' CHECK THAT COLUMNS LETTERS ARE CORRECT! DO NOT CHANGE ROW NUMBER!

Arr = SeaRNG.Value
' Search for SeaSTR
Dim i As Long, j As Long
For i = LBound(Arr) To UBound(Arr)
    For j = LBound(Arr, 2) To UBound(Arr, 2)
        ValToTest = Arr(i, j)
        If InStr(ValToTest, SeaSTR) > 0 And Len(ValToTest) <= SeaLenghtINT Then
            RowSTR = RowSTR & i & ","
        End If
    Next j
Next i

' Creating Array for Rows to Delete
RowArr = Split(Left(RowSTR, Len(RowSTR) - 1), ",")

' Deleting Rows
For i = UBound(RowArr) To LBound(RowArr) Step -1
    SeaRNG.Rows(RowArr(i) - 3 & ":" & RowArr(i) + 3).EntireRow.Delete
Next i


Sheets("NotePad For CLI").Range("A1:A20500").Value = Sheets("LSP Macro FWD").Range("A1:A20500").Value
Sheets("LSP Macro FWD").Visible = False ' This is not needed for running this VBA -code
Sheets("NotePad For CLI").Columns("A:A").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
Sheets("NotePad For CLI").Range("A1").Select

Debug.Print Timer() - coT ' Timer end
ErrHand:
Application.Calculation = xlAutomatic: Application.ScreenUpdating = True: Application.DisplayAlerts = True
If Err.Number <> 0 Then MsgBox "Something went badly wrong!" & vbCrLf & "VBA-code is ended!" & vbCrLf & vbCrLf & "Error number: " & Err.Number & " " & Err.Description: End

End Sub
Hello Dear,

You are undersant correct When pressing the Button that link to your code it should unhide Sheet "LSP Macro FWD" do the job and copy all of them A1: A20500 to not hiden sheet named NotePad for CLI.

But unfortunately i receive the following error.

XLSM Failed.jpg



The only way to mame your script run is not to define sheet (your yestarday post) and run it on current oppened (already unhiden sheet LSP Macro FWD). I cannot understand why fail :(

Could you help?

Kind Regards,

Dimitris,
 

dvampoulis

New Member
Joined
Feb 13, 2021
Messages
9
Office Version
  1. 365
  2. 2019
  3. 2016
  4. 2013
Platform
  1. Windows

ADVERTISEMENT

"Application.ScreenUpdating = False" is already in the original macro in the "On Error GoTo" line and will be put back on in the "ErrHand:" line.

Sheets ("LSP Macro FWD"). Range ("A1: A20500") is copied -> Sheets ("NotePad For CLI") Range ("A1: A20500")
I wish I understand it right?

VBA Code:
Sub TS_Delete_Rows_V2()

Sheets("LSP Macro FWD").Visible = True ' This is not needed for running this VBA -code
' ***** FOR ERROR HANDLING ****************************************
On Error GoTo ErrHand: Application.Calculation = xlManual: Application.ScreenUpdating = False: Application.DisplayAlerts = False

Dim coT As Single: coT = Timer()
Dim LastRow As Long, SeaLenghtINT As Integer
Dim SeaRNG As Range
Dim Arr As Variant, RowArr As Variant
Dim SeaSTR As String, ValToTest As String, RowSTR As String

Sheets("LSP Macro FWD").Visible = True

SeaLenghtINT = 14                               ' String lenght to search
SeaSTR = "NEXT_HOP_IP = "                       ' String to search

LastRow = Range("A" & Rows.Count).End(xlUp).Row ' CHECK THAT COLUMN LETTER IS CORRECT!
Set SeaRNG = Range("$A1:C" & LastRow)           ' CHECK THAT COLUMNS LETTERS ARE CORRECT! DO NOT CHANGE ROW NUMBER!

Arr = SeaRNG.Value
' Search for SeaSTR
Dim i As Long, j As Long
For i = LBound(Arr) To UBound(Arr)
    For j = LBound(Arr, 2) To UBound(Arr, 2)
        ValToTest = Arr(i, j)
        If InStr(ValToTest, SeaSTR) > 0 And Len(ValToTest) <= SeaLenghtINT Then
            RowSTR = RowSTR & i & ","
        End If
    Next j
Next i

' Creating Array for Rows to Delete
RowArr = Split(Left(RowSTR, Len(RowSTR) - 1), ",")

' Deleting Rows
For i = UBound(RowArr) To LBound(RowArr) Step -1
    SeaRNG.Rows(RowArr(i) - 3 & ":" & RowArr(i) + 3).EntireRow.Delete
Next i


Sheets("NotePad For CLI").Range("A1:A20500").Value = Sheets("LSP Macro FWD").Range("A1:A20500").Value
Sheets("LSP Macro FWD").Visible = False ' This is not needed for running this VBA -code
Sheets("NotePad For CLI").Columns("A:A").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
Sheets("NotePad For CLI").Range("A1").Select

Debug.Print Timer() - coT ' Timer end
ErrHand:
Application.Calculation = xlAutomatic: Application.ScreenUpdating = True: Application.DisplayAlerts = True
If Err.Number <> 0 Then MsgBox "Something went badly wrong!" & vbCrLf & "VBA-code is ended!" & vbCrLf & vbCrLf & "Error number: " & Err.Number & " " & Err.Description: End

End Sub
Sorry forgot to mentioned that i have joined all cells of B and C under Column "A".

Do you think that i need to change something ? e.g the "Rowarr = Split..." ?

XLSM Failed.jpg


Regards,
 

Tupe77

Board Regular
Joined
Nov 26, 2020
Messages
97
Office Version
  1. 365
  2. 2016
Platform
  1. Windows
You're right, I didn't define the sheets. I used an active sheet, so of course "Sheets (" LSP Macro FWD ")" had to be made visible.

Does this version work?

VBA Code:
Sub TS_Delete_Rows_V3()

'Sheets("LSP Macro FWD").Visible = True ' This is not needed for running this VBA -code
' ***** FOR ERROR HANDLING ****************************************
On Error GoTo ErrHand: Application.Calculation = xlManual: Application.ScreenUpdating = False: Application.DisplayAlerts = False
Dim wb As Workbook, wsS As Worksheet, wsD As Worksheet
Set wb = ActiveWorkbook: Set wsS = wb.Sheets("LSP Macro FWD"): Set wsD = wb.Sheets("LSP Macro FWD")
Dim coT As Single: coT = Timer()
Dim LastRow As Long, SeaLenghtINT As Integer
Dim SeaRNG As Range
Dim Arr As Variant, RowArr As Variant
Dim SeaSTR As String, ValToTest As String, RowSTR As String

SeaLenghtINT = 14                               ' String lenght to search
SeaSTR = "NEXT_HOP_IP = "                       ' String to search

LastRow = wsS.Range("A" & Rows.Count).End(xlUp).Row ' CHECK THAT COLUMN LETTER IS CORRECT!
Set SeaRNG = wsS.Range("$A1:C" & LastRow)           ' CHECK THAT COLUMNS LETTERS ARE CORRECT! DO NOT CHANGE ROW NUMBER!

Arr = SeaRNG.Value
' Search for SeaSTR
Dim i As Long, j As Long
For i = LBound(Arr) To UBound(Arr)
    For j = LBound(Arr, 2) To UBound(Arr, 2)
        ValToTest = Arr(i, j)
        If InStr(ValToTest, SeaSTR) > 0 And Len(ValToTest) <= SeaLenghtINT Then
            RowSTR = RowSTR & i & ","
        End If
    Next j
Next i

' Creating Array for Rows to Delete
RowArr = Split(Left(RowSTR, Len(RowSTR) - 1), ",")

' Deleting Rows
For i = UBound(RowArr) To LBound(RowArr) Step -1
    SeaRNG.Rows(RowArr(i) - 3 & ":" & RowArr(i) + 3).EntireRow.Delete
Next i


wsD.Range("A1:A20500").Value = wsS.Range("A1:A20500").Value
'Sheets("LSP Macro FWD").Visible = False ' This is not needed for running this VBA -code
wsD.Columns("A:A").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
wsD.Select
Range("A1").Select

Debug.Print Timer() - coT ' Timer end
ErrHand:
Application.Calculation = xlAutomatic: Application.ScreenUpdating = True: Application.DisplayAlerts = True
If Err.Number <> 0 Then MsgBox "Something went badly wrong!" & vbCrLf & "VBA-code is ended!" & vbCrLf & vbCrLf & "Error number: " & Err.Number & " " & Err.Description: End

End Sub
 

dvampoulis

New Member
Joined
Feb 13, 2021
Messages
9
Office Version
  1. 365
  2. 2019
  3. 2016
  4. 2013
Platform
  1. Windows
You're right, I didn't define the sheets. I used an active sheet, so of course "Sheets (" LSP Macro FWD ")" had to be made visible.

Does this version work?

VBA Code:
Sub TS_Delete_Rows_V3()

'Sheets("LSP Macro FWD").Visible = True ' This is not needed for running this VBA -code
' ***** FOR ERROR HANDLING ****************************************
On Error GoTo ErrHand: Application.Calculation = xlManual: Application.ScreenUpdating = False: Application.DisplayAlerts = False
Dim wb As Workbook, wsS As Worksheet, wsD As Worksheet
Set wb = ActiveWorkbook: Set wsS = wb.Sheets("LSP Macro FWD"): Set wsD = wb.Sheets("LSP Macro FWD")
Dim coT As Single: coT = Timer()
Dim LastRow As Long, SeaLenghtINT As Integer
Dim SeaRNG As Range
Dim Arr As Variant, RowArr As Variant
Dim SeaSTR As String, ValToTest As String, RowSTR As String

SeaLenghtINT = 14                               ' String lenght to search
SeaSTR = "NEXT_HOP_IP = "                       ' String to search

LastRow = wsS.Range("A" & Rows.Count).End(xlUp).Row ' CHECK THAT COLUMN LETTER IS CORRECT!
Set SeaRNG = wsS.Range("$A1:C" & LastRow)           ' CHECK THAT COLUMNS LETTERS ARE CORRECT! DO NOT CHANGE ROW NUMBER!

Arr = SeaRNG.Value
' Search for SeaSTR
Dim i As Long, j As Long
For i = LBound(Arr) To UBound(Arr)
    For j = LBound(Arr, 2) To UBound(Arr, 2)
        ValToTest = Arr(i, j)
        If InStr(ValToTest, SeaSTR) > 0 And Len(ValToTest) <= SeaLenghtINT Then
            RowSTR = RowSTR & i & ","
        End If
    Next j
Next i

' Creating Array for Rows to Delete
RowArr = Split(Left(RowSTR, Len(RowSTR) - 1), ",")

' Deleting Rows
For i = UBound(RowArr) To LBound(RowArr) Step -1
    SeaRNG.Rows(RowArr(i) - 3 & ":" & RowArr(i) + 3).EntireRow.Delete
Next i


wsD.Range("A1:A20500").Value = wsS.Range("A1:A20500").Value
'Sheets("LSP Macro FWD").Visible = False ' This is not needed for running this VBA -code
wsD.Columns("A:A").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
wsD.Select
Range("A1").Select

Debug.Print Timer() - coT ' Timer end
ErrHand:
Application.Calculation = xlAutomatic: Application.ScreenUpdating = True: Application.DisplayAlerts = True
If Err.Number <> 0 Then MsgBox "Something went badly wrong!" & vbCrLf & "VBA-code is ended!" & vbCrLf & vbCrLf & "Error number: " & Err.Number & " " & Err.Description: End

End Sub
Excelent Work!!!!

I Am very happy, 2,5 minutes and the Result is Wonderfull!!!

But on the end it appears again the same error (but has done the job - hide again the sheed "LSP Macro FWD". The paste didn't took place. Probably my code for copy/paste needs review.

Untitled.jpg


Thanks again and again for your valuable help my friend.

Kind Regards

Dimitris
 

dvampoulis

New Member
Joined
Feb 13, 2021
Messages
9
Office Version
  1. 365
  2. 2019
  3. 2016
  4. 2013
Platform
  1. Windows
You're right, I didn't define the sheets. I used an active sheet, so of course "Sheets (" LSP Macro FWD ")" had to be made visible.

Does this version work?

VBA Code:
Sub TS_Delete_Rows_V3()

'Sheets("LSP Macro FWD").Visible = True ' This is not needed for running this VBA -code
' ***** FOR ERROR HANDLING ****************************************
On Error GoTo ErrHand: Application.Calculation = xlManual: Application.ScreenUpdating = False: Application.DisplayAlerts = False
Dim wb As Workbook, wsS As Worksheet, wsD As Worksheet
Set wb = ActiveWorkbook: Set wsS = wb.Sheets("LSP Macro FWD"): Set wsD = wb.Sheets("LSP Macro FWD")
Dim coT As Single: coT = Timer()
Dim LastRow As Long, SeaLenghtINT As Integer
Dim SeaRNG As Range
Dim Arr As Variant, RowArr As Variant
Dim SeaSTR As String, ValToTest As String, RowSTR As String

SeaLenghtINT = 14                               ' String lenght to search
SeaSTR = "NEXT_HOP_IP = "                       ' String to search

LastRow = wsS.Range("A" & Rows.Count).End(xlUp).Row ' CHECK THAT COLUMN LETTER IS CORRECT!
Set SeaRNG = wsS.Range("$A1:C" & LastRow)           ' CHECK THAT COLUMNS LETTERS ARE CORRECT! DO NOT CHANGE ROW NUMBER!

Arr = SeaRNG.Value
' Search for SeaSTR
Dim i As Long, j As Long
For i = LBound(Arr) To UBound(Arr)
    For j = LBound(Arr, 2) To UBound(Arr, 2)
        ValToTest = Arr(i, j)
        If InStr(ValToTest, SeaSTR) > 0 And Len(ValToTest) <= SeaLenghtINT Then
            RowSTR = RowSTR & i & ","
        End If
    Next j
Next i

' Creating Array for Rows to Delete
RowArr = Split(Left(RowSTR, Len(RowSTR) - 1), ",")

' Deleting Rows
For i = UBound(RowArr) To LBound(RowArr) Step -1
    SeaRNG.Rows(RowArr(i) - 3 & ":" & RowArr(i) + 3).EntireRow.Delete
Next i


wsD.Range("A1:A20500").Value = wsS.Range("A1:A20500").Value
'Sheets("LSP Macro FWD").Visible = False ' This is not needed for running this VBA -code
wsD.Columns("A:A").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
wsD.Select
Range("A1").Select

Debug.Print Timer() - coT ' Timer end
ErrHand:
Application.Calculation = xlAutomatic: Application.ScreenUpdating = True: Application.DisplayAlerts = True
If Err.Number <> 0 Then MsgBox "Something went badly wrong!" & vbCrLf & "VBA-code is ended!" & vbCrLf & vbCrLf & "Error number: " & Err.Number & " " & Err.Description: End

End Sub
Found an error on your VBA Code @ wb.Sheets. Corrected it and now is OK.

Set wb = ActiveWorkbook: Set wsS = wb.Sheets("LSP Macro FWD"): Set wsD = wb.Sheets("NotePad For CLI")

Thanks a lot for your valuable help so far! :)

Best Regards,
 

Watch MrExcel Video

Forum statistics

Threads
1,129,804
Messages
5,638,450
Members
417,025
Latest member
MusterDuster

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top