As an addition to my previous question which I got a response to, and which helped me to complete the project in super speedy time, I now have a similar project, for which the original code already works and works well, but, I have two columns which contain as follows:
Column K - Names of ws's and servers and their IP addresses comma delimited Column L - Just the ip addresses
In each batch of names and IP's, or just IP's, there are ranges that I am not interested in having appear in the final output for various reasons.
Sadly, I can't give real examples of the strings, but the following are samplings of what you may find:
K - Mike [10.6.3.4], Mike1 [10.2.3.4], Mike3 [10.165.75.3]....... (differing amount of such L - 10.6.3.4, 10.2.3.4, 10.165.75.3............
The IP's in L are the same as those in K, but not necessarily in the same order.
This does not matter.
I wrote the following sub which runs through all the rows in the excel ws, and reads in the strings and then writes out the same strings without the ranges I do not want (you will see that those are 10.6. and 192.168.
As you will see, I wrote a loop for the first string in a row, and then a second loop for the second string in the same row based on the column, I clean off training commas (I don't know how to set the new array which will hold the "clean" strings the the end length so I get a bit of extra commas which I have to clean) and then I go to the next row until the end.
It works fine.
I just have a feeling that it can be done faster, and cleaner, as well as in one loop and not two, as well as maybe not getting the extra commas that need cleanup.
I'd appreciate any comments or fixes anyone may have.
Again, it works fine, but it feels "unclean" if you understand what I mean.
'Sub to remove unwanted IP ranges from both columns
Sub CleanNamesIPsfromList()
Const Col_Names = "J"
Const Col_IPs = "K"
Const ROW_NamesIPs = 5 'First line of Names and IP's
Dim wb As Workbook
Dim wsMain As Worksheet
Dim arHoldNames() As String, arHoldIPs() As String
Dim arPutNames() As String, arPutIPs() As String
Dim strHoldNames As String, strHoldIPs As String
Dim txt106 As String, txt192168 As String
Dim rn As Long, rhn As Long, ri As Long, rhi As Long, lastrowN As Long, lastrowI As Long, i As Long
txt106 = "10.6."
txt192168 = "192.168."
Set wb = ActiveWorkbook
With wb
Set wsMain = .Sheets("Main")
End With
With wsMain
lastrowN = .Cells(.Rows.Count, Col_Names).End(xlUp).Row
lastrowI = .Cells(.Rows.Count, Col_IPs).End(xlUp).Row
If lastrowN < ROW_NamesIPs Or lastrowI < ROW_NamesIPs Then
MsgBox "No text found in Columns " & Col_Names & " " & Col_IPs, vbCritical
Exit Sub
End If
'Run through whole ws row by row in both columns
For i = ROW_NamesIPs To lastrowN
rhn = 0
'Load list of names into string holder
strHoldNames = .Cells(i, Col_Names).Value
'Split the string into the holding array based on the comma
arHoldNames = Split(strHoldNames, ",")
'Loop through the array to find those names not containg unwanted data
ReDim arPutNames(0 To UBound(arHoldNames))
For rn = 0 To UBound(arHoldNames)
If InStr(1, arHoldNames(rn), txt106, vbTextCompare) > 0 Or InStr(1, arHoldNames(rn), txt192168, vbTextCompare) > 0 Then
'If it contains unwanted string, increment rn to next array cell and move on
rn = rn 1
Else
'I want this string so put in new array holder and increment array counter
arPutNames(rhn) = arHoldNames(rn)
rhn = rhn 1
End If
Next 'Loop through array holding origional string
'I have what I want, so put it back in relevant cell in ws
.Cells(i, Col_Names).Value = Join(arPutNames, ",")
'Remove all trailing commas
While Right(.Cells(i, Col_Names).Value, 1) = ","
.Cells(i, Col_Names).Value = Left(.Cells(i, Col_Names).Value, Len(.Cells(i, Col_Names).Value) - 1)
Wend
rhi = 0
'Load list of names into string holder
strHoldIPs = .Cells(i, Col_IPs).Value
'Split the string into the holding array based on the comma
arHoldIPs = Split(strHoldIPs, ",")
'Loop through the array to find those names not containg unwanted data
ReDim arPutIPs(0 To UBound(arHoldIPs))
For ri = 0 To UBound(arHoldIPs)
If InStr(1, arHoldIPs(ri), txt106, vbTextCompare) > 0 Or InStr(1, arHoldIPs(ri), txt192168, vbTextCompare) > 0 Then
'If it contains unwanted string, increment ri to next array cell and move on
ri = ri 1
Else
'I want this string so put in new array holder and increment array counter
arPutIPs(rhi) = arHoldIPs(ri)
rhi = rhi 1
End If
Next 'Loop through array holding origional string
'I have what I want, so put it back in relevant cell in ws
.Cells(i, Col_IPs).Value = Join(arPutIPs, ",")
'Remove all trailing commas
While Right(.Cells(i, Col_IPs).Value, 1) = ","
.Cells(i, Col_IPs).Value = Left(.Cells(i, Col_IPs).Value, Len(.Cells(i, Col_IPs).Value) - 1)
Wend
Next 'Move to next row and repeat untill end
End With 'End main
End Sub
New CODE
Ok, based on the reading all the data into the array, I wrote this section of code (borrowing of course from betters).
Dim Lastcell As Range
Set LastCell = .Range("K5:L5").End(xlDown)
'capture all of the data at once with a range-array copy
Dim arHoldAllNames As String, ArHoldAllIPs As String
arHoldAllNames = .Range("K5", LastCell).Value
ArHoldAllIPs = .Range("L5", LastCell).Value
for i = 0 to UBound(arHoldAllNames, 1)
'Code for Names
Next
for i = 0 to UBound(ArHoldAllIPs, 1)
'Code for IPs
Next
temp = 0
For i = 5 To LastCell
.Cells(i, Col_Names).Value = arHoldAllNames(temp)
.Cells(i, Col_IPs).Value = ArHoldAllIPs(temp)
i = i 1
temp = temp 1
Next
Is this what you all meant ?
Also, I saw I can read a range of data into an array, which definetaly speeds things up.
So that would be this bit of code:
arHoldAllNames = .Range("K5", LastCell).Value
arHoldAllIPs = .Range("L5", LastCell).Value
Can I then reverse that and do:
.Range("K5", LastCell).Value = arHoldAllNames
.Range("L5", LastCell).Value = arHoldAllIPs
And have all the cells in the ws propogates with what is in the arrays ?
Or do I still need to do the For loop:
temp = 0
For i = 5 To LastCell
.Cells(i, Col_Names).Value = arHoldAllNames(temp)
.Cells(i, Col_IPs).Value = ArHoldAllIPs(temp)
i = i 1
temp = temp 1
Next
CodePudding user response：
Here is an example of how to do it with Range-Array copying:
'Sub to remove unwanted IP ranges from both columns
Sub CleanNamesIPsfromList()
Const Col_Names = "J"
Const Col_IPs = "K"
Const ROW_NamesIPs = 5 'First line of Names and IP's
Dim wb As Workbook
Dim wsMain As Worksheet
Dim arHoldNames() As String, arHoldIPs() As String
Dim arPutNames() As String, arPutIPs() As String
Dim strHoldNames As String, strHoldIPs As String
Dim txt106 As String, txt192168 As String
Dim rn As Long, rhn As Long, ri As Long, rhi As Long, lastrowN As Long, lastrowI As Long, i As Long
txt106 = "10.6."
txt192168 = "192.168."
Set wb = ActiveWorkbook
With wb
Set wsMain = .Sheets("Main")
End With
Dim NamCel As Variant
Dim IpCal As Variant
With wsMain
lastrowN = .Cells(.Rows.Count, Col_Names).End(xlUp).Row
lastrowI = .Cells(.Rows.Count, Col_IPs).End(xlUp).Row
If lastrowN < ROW_NamesIPs Or lastrowI < ROW_NamesIPs Then
MsgBox "No text found in Columns " & Col_Names & " " & Col_IPs, vbCritical
Exit Sub
End If
' Range-array copy the data into VBA
NamCel = .Range(Col_Names & "1:" & Col_Names & lastrowN)
IpCel = .Range(Col_IPs & "1:" & Col_IPs & lastrowI)
'Run through whole ws row by row in both columns
For i = ROW_NamesIPs To lastrowN
rhn = 0
'Load list of names into string holder
'strHoldNames = .Cells(i, Col_Names).Value
strHoldNames = NamCel(i, 1)
'Split the string into the holding array based on the comma
arHoldNames = Split(strHoldNames, ",")
'Loop through the array to find those names not containg unwanted data
ReDim arPutNames(0 To UBound(arHoldNames))
For rn = 0 To UBound(arHoldNames)
If InStr(1, arHoldNames(rn), txt106, vbTextCompare) > 0 Or InStr(1, arHoldNames(rn), txt192168, vbTextCompare) > 0 Then
'If it contains unwanted string, increment rn to next array cell and move on
rn = rn 1
Else
'I want this string so put in new array holder and increment array counter
arPutNames(rhn) = arHoldNames(rn)
rhn = rhn 1
End If
Next 'Loop through array holding origional string
'I have what I want, so put it back in relevant cell in ws
'.Cells(i, Col_Names).Value = Join(arPutNames, ",")
NamCel(i, 1) = Join(arPutNames, ",")
'Remove all trailing commas
While Right(NamCel(i, 1), 1) = ","
NamCel(i, 1) = Left(NamCel(i, 1), Len(NamCel(i, 1)) - 1)
Wend
rhi = 0
'Load list of names into string holder
strHoldIPs = IpCel(i, 1)
'Split the string into the holding array based on the comma
arHoldIPs = Split(strHoldIPs, ",")
'Loop through the array to find those names not containg unwanted data
ReDim arPutIPs(0 To UBound(arHoldIPs))
For ri = 0 To UBound(arHoldIPs)
If InStr(1, arHoldIPs(ri), txt106, vbTextCompare) > 0 Or InStr(1, arHoldIPs(ri), txt192168, vbTextCompare) > 0 Then
'If it contains unwanted string, increment ri to next array cell and move on
ri = ri 1
Else
'I want this string so put in new array holder and increment array counter
arPutIPs(rhi) = arHoldIPs(ri)
rhi = rhi 1
End If
Next 'Loop through array holding origional string
'I have what I want, so put it back in relevant cell in ws
IpCel(i, 1) = Join(arPutIPs, ",")
'Remove all trailing commas
While Right(.Cells(i, Col_IPs).Value, 1) = ","
IpCel(i, 1) = Left(IpCel(i, 1), Len(IpCel(i, 1)) - 1)
Wend
Next 'Move to next row and repeat untill end
' Range-array copy the data back out to Excel
.Range(Col_Names & "1:" & Col_Names & lastrowN) = NamCel
.Range(Col_IPs & "1:" & Col_IPs & lastrowI) = IpCel
End With 'End main
End Sub
CodePudding user response：
Ok.
With the ideas given, and the code help RBarryYoung wrote, and a simple change to get rid of the subscript out of range error I was getting when reading the string from the main array into the small work array, the code is as follows.
'Sub to remove unwanted IP ranges from both columns
Sub CleanNamesIPsfromList()
Const Col_Names = "J"
Const Col_IPs = "K"
Const StrtRow = 5 'First line of Names and IP's
Dim wb As Workbook
Dim wsMain As Worksheet
Dim arHoldNames() As String, arHoldIPs() As String
Dim arPutNames() As String, arPutIPs() As String
Dim strHoldNames As String, strHoldIPs As String
Dim txt106 As String, txt192168 As String
Dim rn As Long, rhn As Long, ri As Long, rhi As Long, lastrowN As Long, lastrowI As Long, i As Long, RlLstRw As Long
Dim NamCel As Variant, IpCal As Variant
txt106 = "10.6."
txt192168 = "192.168."
Set wb = ActiveWorkbook
With wb
Set wsMain = .Sheets("Main")
End With
With wsMain
lastrowN = .Cells(.Rows.Count, Col_Names).End(xlUp).Row
lastrowI = .Cells(.Rows.Count, Col_IPs).End(xlUp).Row
If lastrowN < StrtRow Or lastrowI < StrtRow Then
MsgBox "No text found in Columns " & Col_Names & " " & Col_IPs, vbCritical
Exit Sub
End If
' Range-array copy the data into VBA
NamCel = .Range(Col_Names & StrtRow & ":" & Col_Names & lastrowN)
IpCel = .Range(Col_IPs & StrtRow & ":" & Col_IPs & lastrowI)
'Run through whole ws row by row in both columns
RlLstRw = lastrowN - 4
For i = 1 To RlLstRw
rhn = 0
'Load list of names into string holder
'strHoldNames = NamCel(i, 1)
strHoldNames = NamCel(i, 1)
'Split the string into the holding array based on the comma
arHoldNames = Split(strHoldNames, ",")
'Loop through the array to find those names not containg unwanted data
ReDim arPutNames(0 To UBound(arHoldNames))
For rn = 0 To UBound(arHoldNames)
If InStr(1, arHoldNames(rn), txt106, vbTextCompare) > 0 Or InStr(1, arHoldNames(rn), txt192168, vbTextCompare) > 0 Then
'If it contains unwanted string, increment rn to next array cell and move on
rn = rn 1
Else
'I want this string so put in new array holder and increment array counter
arPutNames(rhn) = arHoldNames(rn)
rhn = rhn 1
End If
Next 'Loop through array holding origional string
'I have what I want, so put it back in relevant cell in ws
NamCel(i, 1) = Join(arPutNames, ",")
'Remove all trailing commas
While Right(NamCel(i, 1), 1) = ","
NamCel(i, 1) = Left(NamCel(i, 1), Len(NamCel(i, 1)) - 1)
Wend
rhi = 0
'Load list of names into string holder
strHoldIPs = IpCel(i, 1)
'Split the string into the holding array based on the comma
arHoldIPs = Split(strHoldIPs, ",")
'Loop through the array to find those names not containg unwanted data
ReDim arPutIPs(0 To UBound(arHoldIPs))
For ri = 0 To UBound(arHoldIPs)
If InStr(1, arHoldIPs(ri), txt106, vbTextCompare) > 0 Or InStr(1, arHoldIPs(ri), txt192168, vbTextCompare) > 0 Then
'If it contains unwanted string, increment ri to next array cell and move on
ri = ri 1
Else
'I want this string so put in new array holder and increment array counter
arPutIPs(rhi) = arHoldIPs(ri)
rhi = rhi 1
End If
Next 'Loop through array holding origional string
'I have what I want, so put it back in relevant cell in ws
IpCel(i, 1) = Join(arPutIPs, ",")
'Remove all trailing commas
While Right(.Cells(i, Col_IPs).Value, 1) = ","
IpCel(i, 1) = Left(IpCel(i, 1), Len(IpCel(i, 1)) - 1)
Wend
Next 'Move to next row and repeat untill end
' Range-array copy the data back out to Excel
.Range(Col_Names & StrtRow & ":" & Col_Names & lastrowN) = NamCel
.Range(Col_IPs & StrtRow & ":" & Col_IPs & lastrowI) = IpCel
End With 'End main
End Sub
Thank you everyone. Great help as always.
The script runs on my laptop about 120 times faster with 8,323 rows (2 and a bit seconds to complete it all). So on my ws it will be even faster.