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

D

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.
 
Sort by date Sort by votes
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:
Upvote 0

Excel Facts

Copy PDF to Excel
Select data in PDF. Paste to Microsoft Word. Copy from Word and paste to Excel.
Tupe77 said:
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
Click to expand...
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
 
Upvote 0
"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
 
Upvote 0
Tupe77 said:
"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
Click to expand...
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,
 
Upvote 0
Tupe77 said:
"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
Click to expand...
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,
 
Upvote 0
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
 
Upvote 0
Tupe77 said:
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
Click to expand...
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
 
Upvote 0
Tupe77 said:
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
Click to expand...
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,
 
Upvote 0
You must log in or register to reply here.

Similar threads

V
  • Solved
Need VBA to split data into multiple sheets paste formulas, formatting AND data validation
Replies
2
Views
126
vanessavalentino83
V
Rhodie72
  • Question Question
How to write a data to a text file (VBA)
2
Replies
17
Views
1K
Rhodie72
Rhodie72
D
  • Locked
  • Question Question
VBA to copy only matching data from 2 csv workbooks into the "Master Workbook"
Replies
1
Views
338
RoryA
RoryA
I
  • Question Question
Modify VBA script to count rows with data in multiple sheets
Replies
0
Views
419
irishjsk
I
T
  • Question Question
VBA code not working correctly
Replies
1
Views
429
Skyybot
Skyybot

Forum statistics

Threads
1,224,827
Messages
6,181,200
Members
453,022
Latest member
RobertV1609

Share this page

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
Back
Top