VPN Forum access and IP addresse Tests

**DocAElstein** · 09-16-2015, 03:25 PM

**DocAElstein** · 09-16-2015, 06:44 PM

Notes in support of these Threads
https://stackoverflow.com/questions/...46481#59346481
http://www.eileenslounge.com/viewtop...=33775#p261670
http://www.eileenslounge.com/viewtop...=33775#p261670
http://www.excelfox.com/forum/showth...ll=1#post11608
https://tinyurl.com/rwt2kx8 , https://tinyurl.com/yhrwdsdb

( notes which I might use in a Blog at a later date )

Automating fixes and investigations in XP

Information as text string, programmatically obtaining
In addition to time saving, advantages of automating the fixes discussed allow for more consistent results, since it was apparent from initial investigations that the timing at which commands such as ipconfig /release and ipconfig/ renew where typed manually seemed to have an effect.

It turns out that automating off theses commands via VBA is very simple, in principle a single code line does the main action http://www.eileenslounge.com/viewtop...=33775#p261628
of doing the command, and additionally storing the contents displayed as a result of the command, into a text file

Further manipulation of the text file information
Using VBA lends itself to bringing the data into a convenient form into Excel such as in columns for ease of comparing.
When doing this manually, some untidy behavior was sometimes seen, such as extra unnecessary blank lines and information spilling into adjoining columns. So some initial investigation into the actual build up of the text file is useful.
The complete text in a text file, or a column in Excel , is actually just a single long text string. The different "lines" of text as we perceive it is made possible by the inclusion "invisible characters" of the so called "line feed" and / or "carriage return" form. If we analyze typical strings in detail then this will help us in deciding how to manipulate them in order to get consistent / tidy results
We need to first produce a simple long text string, which we can then analyze, for example using this coding: http://www.excelfox.com/forum/showth...ts-of-a-string
The following macro example, will give us the required complete string for ipconfig /all in variable strIPcon

Code:

  Sub cmdconsoleContentsToString()
    Shell "cmd.exe /c ""ipconfig /all > """ & ThisWorkbook.Path & "\ipconfig__all.txt"""""
' Get the entire text file as a string
Dim FileNum As Long: Let FileNum = FreeFile(1) '
Dim PathAndFileName As String, strIPcon As String
 Let PathAndFileName = ThisWorkbook.Path & "\ipconfig__all.txt"
  Open PathAndFileName For Binary As #FileNum 'Open Route to data. Binary is a fundemental type data input...
    strIPcon = VBA.Strings.Space$(LOF(FileNum)) '....and wot recives it hs to be a string of exactly the right length
    Get #FileNum, , strIPcon
  Close #FileNum
' Analyse string
Call WtchaGot(strIn:=strIPcon)
End Sub

( Sub WtchaGot(ByVal strIn As String) can be found here : http://www.excelfox.com/forum/showth...ll=1#post10946

The results from Sub WtchaGot( ) can be used in analyzing the text format given out by the command prompt code live.

Alternatively, if you already have the results in a text file, then you use the same basic coding without the initial commend prompt code line. You will need to know the file name and location of the text file.

Code:

Sub StringContentsFromTextfile()
' Get the entire text file as a string
Dim FileNum As Long: Let FileNum = FreeFile(1) '
Dim PathAndFileName As String, strIPcon As String
 Let PathAndFileName = ThisWorkbook.Path & "\test1B"
  Open PathAndFileName For Binary As #FileNum 'Open Route to data. Binary is a fundemental type data input...
    strIPcon = VBA.Strings.Space$(LOF(FileNum)) '....and wot recives it hs to be a string of exactly the right length
    Get #FileNum, , strIPcon
  Close #FileNum
' Analyse string
Call WtchaGot(strIn:=strIPcon)
End Sub

Some Examples:
When trying to compare some similar measurements for Vista and XP operating systems, two annoying characteristics were noticed
_ In XP there seemed to be extra lines, XP Extra Blank Lines.JPG : https://imgur.com/flm1pjQ

Looking at the first part of a typical Vista output from Sub WtchaG( ) , we see this First Part of Typical Vista Output ipconfig all.JPG , https://imgur.com/Zxkyxkq

vbCr & vbLf & "Windows" & "-" & "IP" & "-" & "Konfiguration" & vbCr & vbLf & vbCr & vbLf & " " & " " & " " & "Hostname" & " " & "…………..
Comparing that with a similarly generated text in XP we see this First Part of Typical XP Output ipconfig all.JPG : https://imgur.com/nXtTeQH

vbCr & vbCr & vbLf & "Windows" & "-" & "IP" & "-" & "Konfiguration" & vbCr & vbCr & vbLf & vbCr & vbCr & vbLf & " " & " " & " " & " " & " " & " " & " " & " " & "Hostname" & "."…………….
Clearly we see in the XP output a doubling of vbCr where we might more typically see a single vbCr
We can use a simple VBA code line to easily replace double occurrences of vbCr with a single vbCr

_ Spilling into neighboring columns when pasted into Excel
Another annoyance shows up as contents spilling into neighboring columns when pasted into Excel : XP Spilling into neighboring columns.JPG : https://imgur.com/8aWq5uj
Examining parts of the offending string, we see that there are some occurrences of vbTab, XP Spilling into neighboring columns due to vbTab.JPG :
…………" & " " & " " & "192" & "." & "168" & "." & "2" & "." & "105" & vbTab & " " & " " & "25" & vbCr & vbLf………..
In sinple text, vbTab is used as a sort of ordered positioning separation by empty spaces. Unfortunately , VBA uses them to indicate a cell vertical wall.
To overcome this problem we can use a simple VBA code line to easily replace occurrences of vbTab with a few empty spaces.

A final code to tidy the text given, by a command such as ipconfig /all , would have this form:

Code:

Sub cmdconsoleContentsToStringTidy() '  http://www.excelfox.com/forum/showthread.php/2384-VPN-Forum-access-and-IP-addresse-Tests?p=11568&viewfull=1#post11568
 Shell "cmd.exe /c ""ipconfig /all > """ & ThisWorkbook.Path & "\ipconfig__all.txt"""""
' Get the entire text file as a string
Dim FileNum As Long: Let FileNum = FreeFile(1) '
Dim PathAndFileName As String, strIPcon As String
 Let PathAndFileName = ThisWorkbook.Path & "\ipconfig__all.txt"
  Open PathAndFileName For Binary As #FileNum 'Open Route to data. Binary is a fundemental type data input...
    strIPcon = VBA.Strings.Space$(LOF(FileNum)) '....and wot recives it hs to be a string of exactly the right length
    Get #FileNum, , strIPcon
  Close #FileNum
' Tidy the string
 Let strIPcon = Replace(strIPcon, vbCr & vbCr, vbCr, 1, 1, vbBinaryCompare)
 Let strIPcon = Replace(strIPcon, vbTab, "   ", 1, 1, vbBinaryCompare)
End Sub

Ref
http://eileenslounge.com/viewtopic.p...=33775#p261628

**DocAElstein** · 09-16-2015, 06:47 PM

Automating fixes and investigations in XP

Bringing results into Excel File
It is convenient to bring the text results into an excel column.
Manually we do this by simply pasting into a single cell: Because the text string has already got a degree of formatting into lines via the vbCr & vbLf s , this is recognized by Excl, since excel also uses the convention of vbCr & vbLf as the line separator or, as Excel sees it, as a horizontal cell wall border.
So we simply need to add a few code lines to put the text string into the clipboard, and then paste into a convenient cell in Excel.
( A few probllems were encountered when adding some extra information. These are the subject of some other forum posts, for example: https://www.eileenslounge.com/viewto...p?f=18&t=33834 )

Code:

Sub cmdconsoleContentsToExcel() '  http://www.excelfox.com/forum/showthread.php/2384-VPN-Forum-access-and-IP-addresse-Tests?p=11569&viewfull=1#post11569
 Shell "cmd.exe /c ""ipconfig /all > """ & ThisWorkbook.Path & "\ipconfig__all.txt"""""
' Get the entire text file as a string
Dim FileNum As Long: Let FileNum = FreeFile(1) '
Dim PathAndFileName As String, strIPcon As String
 Let PathAndFileName = ThisWorkbook.Path & "\ipconfig__all.txt"
 ' Let PathAndFileName = ThisWorkbook.Path & "\test2B.txt"  '  Al
  Open PathAndFileName For Binary As #FileNum 'Open Route to data. Binary is a fundemental type data input...
    strIPcon = VBA.Strings.Space$(LOF(FileNum)) '....and wot recives it hs to be a string of exactly the right length
    Get #FileNum, , strIPcon
  Close #FileNum
' Tidy the string
 Let strIPcon = Replace(strIPcon, vbCr & vbCr, vbCr, 1, 1, vbBinaryCompare)
 Let strIPcon = Replace(strIPcon, vbTab, "   ", 1, 1, vbBinaryCompare)
' add any extra info to string
  Let strIPcon = vbCr & vbLf & vbCr & vbLf & vbCr & vbLf & vbCr & vbLf & vbCr & vbLf & """" & Format(Now, "DD MMM YYYY") & " " & vbLf & " " & Format(Now, "hh mm ss") & """" & vbCr & vbLf & vbCr & vbLf & vbCr & vbLf & strIPcon  ' vbLf is recognised as a new line within an Excel"
' String content check
' Call WtchaGot(strIPcon)
' put the text in the clipboard
Dim objDataObject As Object: Set objDataObject = GetObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
objDataObject.SetText strIPcon: objDataObject.PutInClipboard

' Excel Worksheet
Dim Ws As Worksheet: Set Ws = ActiveSheet
Dim Clm As Range, NxtClm As Long
 Set Clm = Ws.Cells.Find(What:="*", After:=Ws.Range("A1"), LookAt:=xlPart, LookIn:=xlFormulas, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious, MatchCase:=False)
    If Clm Is Nothing Then
     Let NxtClm = 1
    Else
     Let NxtClm = Clm.Column + 1
    End If
' Put in next free column in Active sheet
 Ws.Paste Destination:=Ws.Cells.Item(1, NxtClm)
 Ws.Columns.AutoFit: Ws.Rows.AutoFit


End Sub

The next coding has a section to add the results obtained in the command window for the command route print

Code:

Sub ipconfigall_routeprint() '
Rem 1 ipconfig /all
 Shell "cmd.exe /c ""ipconfig /all > """ & ThisWorkbook.Path & "\ipconfig__all.txt"""""
' Get the entire text file as a string
Dim FileNum As Long: Let FileNum = FreeFile(1) '
Dim PathAndFileName As String, strIPcon As String
 Let PathAndFileName = ThisWorkbook.Path & "\ipconfig__all.txt"
 ' Let PathAndFileName = ThisWorkbook.Path & "\test2B.txt"  '  Al
  Open PathAndFileName For Binary As #FileNum 'Open Route to data. Binary is a fundemental type data input...
    strIPcon = VBA.Strings.Space$(LOF(FileNum)) '....and wot recives it hs to be a string of exactly the right length
    Get #FileNum, , strIPcon
  Close #FileNum
' Tidy the string
 Let strIPcon = Replace(strIPcon, vbCr & vbCr, vbCr, 1, 1, vbBinaryCompare)
 Let strIPcon = Replace(strIPcon, vbTab, "   ", 1, 1, vbBinaryCompare)
' add any extra info to string
  Let strIPcon = vbCr & vbLf & vbCr & vbLf & vbCr & vbLf & vbCr & vbLf & vbCr & vbLf & """" & Format(Now, "DD MMM YYYY") & " " & vbLf & " " & Format(Now, "hh mm ss") & """" & vbCr & vbLf & vbCr & vbLf & vbCr & vbLf & strIPcon  ' vbLf is recognised as a new line within an Excel"
' String content check
' Call WtchaGot(strIPcon)
' put the text in the clipboard
Dim objDataObject As Object: Set objDataObject = GetObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
objDataObject.SetText strIPcon: objDataObject.PutInClipboard

' Excel Worksheet
Dim Ws As Worksheet: Set Ws = ActiveSheet
Dim Clm As Range, NxtClm As Long
 Set Clm = Ws.Cells.Find(What:="*", After:=Ws.Range("A1"), LookAt:=xlPart, LookIn:=xlFormulas, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious, MatchCase:=False)
    If Clm Is Nothing Then
     Let NxtClm = 1
    Else
     Let NxtClm = Clm.Column + 1
    End If
' Put in next free column in Active sheet
 Ws.Paste Destination:=Ws.Cells.Item(1, NxtClm)
' Ws.Columns.AutoFit: Ws.Rows.AutoFit

Rem 2 route print
 Shell "cmd.exe /c ""route print > """ & ThisWorkbook.Path & "\route_print.txt"""""
' Get the entire text file as a string
 Let FileNum = FreeFile(1) '
Dim strrouteprint As String
 Let PathAndFileName = ThisWorkbook.Path & "\route_print.txt"
 ' Let PathAndFileName = ThisWorkbook.Path & "\test2B.txt"  '  Al
  Open PathAndFileName For Binary As #FileNum 'Open Route to data. Binary is a fundemental type data input...
    strrouteprint = VBA.Strings.Space$(LOF(FileNum)) '....and wot recives it hs to be a string of exactly the right length
    Get #FileNum, , strrouteprint
  Close #FileNum
' Tidy the string
 Let strrouteprint = Replace(strrouteprint, vbCr & vbCr, vbCr, 1, 1, vbBinaryCompare)
 Let strrouteprint = Replace(strrouteprint, vbTab, "   ", 1, 1, vbBinaryCompare)
' put the text in the clipboard
objDataObject.SetText strrouteprint: objDataObject.PutInClipboard
' Excel Worksheet
Dim Lr As Long: Let Lr = Ws.Cells(Ws.Rows.Count, NxtClm).End(xlUp).Row
' Put in next free column in Active sheet
 Ws.Paste Destination:=Ws.Cells.Item(Lr + 30, NxtClm)
 Ws.Columns.AutoFit: Ws.Rows.AutoFit

End Sub

Typically , ipconfig/ all and route print are done together to get information concerning a connection.
A code version here, http://www.excelfox.com/forum/showth...ll=1#post11834 , combines the two macros and the two sets of info is pasted out to the same column, with the and route print info under the ipconfig/ all info.
In addition the coding calls some Functions which give some extra information , such IP address, computer name. Details to those Functions is given here : http://www.excelfox.com/forum/showth...ll=1#post11672

Ref
http://eileenslounge.com/viewtopic.p...=31395#p243002

**DocAElstein** · 09-16-2015, 09:00 PM

Other useful command prompt commands when experimenting with VPN are ipconfig /release and ipconfig /renew

Here is are a pair of macros to give a similar Excel column output for the commands are ipconfig /release and ipconfig /renew

Code:


'
Sub ipconfig_release() '
Rem 1 ipconfig /all
 Shell "cmd.exe /c ""ipconfig /release > """ & ThisWorkbook.Path & "\ipconfig_release.txt"""""
' Get the entire text file as a string
Dim FileNum As Long: Let FileNum = FreeFile(1) '      ' The "highway/ street/ link" to be built to transport the text will be given a number. It must be unique. So we use for convenience, the Freefile function: it returns an integer that represents the next file number that the Open statement can use.  The optional argument for the range number is a variant that is used to specify a range from which the next free file number is returned. Enter a value of data type 0 (default) to return a file number in the range 1 - 255 inclusive. Enter 1 to return a file number in the range 256 - 511.   https://docs.microsoft.com/en-us/office/vba/language/reference/user-interface-help/freefile-function  . Note also : Use file numbers in the range 1-255, inclusive, for files not accessible to other applications. Use file numbers in the range 256-511 for files accessible from other applications
Dim PathAndFileName As String, strIPcon As String
 Let PathAndFileName = ThisWorkbook.Path & "\ipconfig_release.txt"
 ' Let PathAndFileName = ThisWorkbook.Path & "\test2B.txt"  '  Al
  Open PathAndFileName For Binary As #FileNum 'Open Route to data. Binary is a fundemental type data input...
    strIPcon = VBA.Strings.Space$(LOF(FileNum)) '....and wot recives it hs to be a string of exactly the right length
    Get #FileNum, , strIPcon
  Close #FileNum
' Tidy the string
 Let strIPcon = Replace(strIPcon, vbCr & vbCr, vbCr, 1, -1, vbBinaryCompare)
 Let strIPcon = Replace(strIPcon, vbTab, "   ", 1, -1, vbBinaryCompare)
' add any extra info to string
Dim PublicIP As String: Call PubicIP(PublicIP)
  Let strIPcon = "ipconfig /release  " & vbCr & vbLf & ComputerName & vbCr & vbLf & GetIpAddrTable & vbCr & vbLf & PublicIP & vbCr & vbLf & vbCr & vbLf & """" & Format(Now, "DD MMM YYYY") & " " & vbLf & " " & Format(Now, "hh mm ss") & """" & vbCr & vbLf & vbCr & vbLf & vbCr & vbLf & vbCr & vbLf & vbCr & vbLf & vbCr & vbLf & strIPcon      ' vbLf is recognised as a new line within an Excel"
' String content check
' Call WtchaGot(strIPcon)
' put the text in the clipboard
Dim objDataObject As Object: Set objDataObject = GetObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
objDataObject.SetText strIPcon: objDataObject.PutInClipboard

' Excel Worksheet
Dim Ws As Worksheet: Set Ws = ActiveSheet
Dim Clm As Range, NxtClm As Long
 Set Clm = Ws.Cells.Find(What:="*", After:=Ws.Range("A1"), LookAt:=xlPart, LookIn:=xlFormulas, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious, MatchCase:=False)
    If Clm Is Nothing Then
     Let NxtClm = 2
    Else
     Let NxtClm = Clm.Column + 1
    End If
' Put in next free column in Active sheet
 Ws.Paste Destination:=Ws.Cells.Item(1, NxtClm)
 Ws.Columns.AutoFit: Ws.Rows.AutoFit
 ActiveWindow.Panes(2).Activate
 Ws.Cells.Item(1, NxtClm).Select

End Sub

Code:


'
Sub ipconfig_renew() '
Rem 1 ipconfig /all
 Shell "cmd.exe /c ""ipconfig /renew > """ & ThisWorkbook.Path & "\ipconfig_renew.txt"""""
' Get the entire text file as a string
Dim FileNum As Long: Let FileNum = FreeFile(1) '        ' The "highway/ street/ link" to be built to transport the text will be given a number. It must be unique. So we use for convenience, the Freefile function: it returns an integer that represents the next file number that the Open statement can use.  The optional argument for the range number is a variant that is used to specify a range from which the next free file number is returned. Enter a value of data type 0 (default) to return a file number in the range 1 - 255 inclusive. Enter 1 to return a file number in the range 256 - 511.   https://docs.microsoft.com/en-us/office/vba/language/reference/user-interface-help/freefile-function  . Note also : Use file numbers in the range 1-255, inclusive, for files not accessible to other applications. Use file numbers in the range 256-511 for files accessible from other applications
Dim PathAndFileName As String, strIPcon As String
 Let PathAndFileName = ThisWorkbook.Path & "\ipconfig_renew.txt"
 ' Let PathAndFileName = ThisWorkbook.Path & "\test2B.txt"  '  Al
  Open PathAndFileName For Binary As #FileNum 'Open Route to data. Binary is a fundemental type data input...
    strIPcon = VBA.Strings.Space$(LOF(FileNum)) '....and wot recives it hs to be a string of exactly the right length
    Get #FileNum, , strIPcon
  Close #FileNum
' Tidy the string
 Let strIPcon = Replace(strIPcon, vbCr & vbCr, vbCr, 1, -1, vbBinaryCompare)
 Let strIPcon = Replace(strIPcon, vbTab, "   ", 1, -1, vbBinaryCompare)
' add any extra info to string
Dim PublicIP As String: Call PubicIP(PublicIP)
  Let strIPcon = "ipconfig /renew  " & vbCr & vbLf & ComputerName & vbCr & vbLf & GetIpAddrTable & vbCr & vbLf & PublicIP & vbCr & vbLf & vbCr & vbLf & """" & Format(Now, "DD MMM YYYY") & " " & vbLf & " " & Format(Now, "hh mm ss") & """" & vbCr & vbLf & vbCr & vbLf & vbCr & vbLf & vbCr & vbLf & vbCr & vbLf & vbCr & vbLf & strIPcon      ' vbLf is recognised as a new line within an Excel"
' String content check
' Call WtchaGot(strIPcon)
' put the text in the clipboard
Dim objDataObject As Object: Set objDataObject = GetObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
objDataObject.SetText strIPcon: objDataObject.PutInClipboard

' Excel Worksheet
Dim Ws As Worksheet: Set Ws = ActiveSheet
Dim Clm As Range, NxtClm As Long
 Set Clm = Ws.Cells.Find(What:="*", After:=Ws.Range("A1"), LookAt:=xlPart, LookIn:=xlFormulas, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious, MatchCase:=False)
    If Clm Is Nothing Then
     Let NxtClm = 2
    Else
     Let NxtClm = Clm.Column + 1
    End If
' Put in next free column in Active sheet
 Ws.Paste Destination:=Ws.Cells.Item(1, NxtClm)
 Ws.Columns.AutoFit: Ws.Rows.AutoFit
 ActiveWindow.Panes(2).Activate
 Ws.Cells.Item(1, NxtClm).Select

End Sub

**DocAElstein** · 05-29-2016, 08:07 PM

Automating command prompt combinations

There are two main reasons for the automating of command prompts and associated coding which we have been discussing. One is the obvious time advantage compared with doing the commands manually.

A second important advantage is in consistency of results, since the specific time at which some commands were done were seen to effect the results.

It is easy to Call any combinations of the Functions , along with wait periods in between. Simple macros of this form can be written , Calling on the Functions which we have already developed.

Code:

Option Explicit
'     '      https://www.myonlinetraininghub.com/pausing-or-delaying-vba-using-wait-sleep-or-a-loop
    #If VBA7 Then ' Excel 2010 or later
     Public Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal Milliseconds As LongPtr)
    #Else ' Excel 2007 or earlier
     Public Declare Sub Sleep Lib "kernel32" (ByVal Milliseconds As Long)
    #End If
'                                                                             '_


'  Calls
Sub Calls2()
 Call ipconfig_release
 Call Sleep(500)
 Call ipconfigall_routeprint("  after rel in single rel ren pair")
 Call ipconfig_renew
 Call Sleep(500)
 Call ipconfigall_routeprint("  after ren of single rel ren pair")
End Sub

We can further use either buttons or event coding to trigger conveniently various coding combinations.

The uploaded file is an initial file version which I am currently using to do some experimenting with XP and SoftEther.

I will probably develop this further and edit this post accordingly.

"Test ipconfig XP.xls" https://app.box.com/s/hk3cl2sp9nmmyigcun71w54vn38xi6zq

**DocAElstein** · 06-07-2016, 10:31 PM

Problems with Automated Command prompts with VBA

Problems uncounted in the execution of such coding is often difficult to debug, since often the code lines do not error. Often when problems occur, the commends are simply not done, but the VBA coding continues further.

One problem already noted is the presence of spaces in path strings. Care has to be taken in the correct syntax in the use of quotes, " , to overcome this problem
https://stackoverflow.com/questions/...46481#59346481
http://www.eileenslounge.com/viewtop...261670#p261670

Another strange problem I once experienced , was that the command prompt coding lines were not working on one particular XP computer. I finally tracked the problem down to a point _ . _ in the computer name. Once I removed this point _ . _ all was well.
( I could not repeat the exüeriment, as any attempts to change the name to include a point _ . _ , were not allowed….. This particulate computer I did not have from new . I don't know how a point was made in the computer name)

Ref
Change Computer name in XP : https://www.watchingthenet.com/how-t...-or-vista.html
http://www.excelfox.com/forum/showth...ll=1#post11572

**DocAElstein** · 06-07-2016, 10:32 PM

**DocAElstein** · 06-07-2016, 10:39 PM

"Opened up" snb Code

(_.. Original code here
http://www.excelfox.com/forum/showth...=9714#post9714
_........)

' To Test Function, Type some arbitrary values in range A1:E10, step through code in F8 Debug Mode in VB Editor, and examine Worksheet, Immediate Window ( Ctrl+G when in VB Editor ), hover over variables in the VB Editor Window with mouse cursor, set watches on variables ( Highlight any occurrence of a variable in the VB Editor and Hit Shift+F9 ) , etc.. and then you should expected the required Output to be pasted out starting Top Left at cell M17

Code:

' Delete One Row From a ... group of contiguous cells in a Spreadsheet

' To Test Function, Type some arbitrary values in range A1:E10, step through code in F8 Debug Mode in VB Editor, and examine Worksheet, Immediate Window ( Ctrl+G when in VB Editor ), hover over variables in the VB Editor Window with mouse cursor, set watches on variables ( Highlight  any occurrence of a variable in the VB Editor and Hit Shift+F9 ) , etc.. and then you should expected the required Output to be pasted out starting Top Left at cell M17
' http://www.excelfox.com/forum/showthread.php/2083-Delete-One-Row-From-A-2D-Variant-Array?p=9714#post9714
Sub snb_()
Dim sp() As Variant
 Let sp() = Fu_snb(Range("A1:E10"), 5)
 Range("M17").Resize(UBound(sp(), 1), UBound(sp(), 2)).ClearContents
 Let Range("M17").Resize(UBound(sp(), 1), UBound(sp(), 2)) = sp
End Sub

Required Function_...
Function Fu_snb(ByVal sn As Range, ByVal y As Long) As Variant
_...in next Post

**DocAElstein** · 06-07-2016, 10:42 PM

Required Function for last Post

Code:

Function Fu_snb(ByVal sn As Range, ByVal y As Long) As Variant
10   ' use "neat magic" code line    arrOut() = Application.Index(arrIn(), rwsT(), clms())       http://www.excelforum.com/excel-new-users-basics/1099995-application-index-with-look-up-rows-and-columns-arguments-as-vba-arrays.html        http://www.mrexcel.com/forum/excel-questions/908760-visual-basic-applications-copy-2-dimensional-array-into-1-dimensional-single-column-2.html#post4375354
20   ' So we have sn as a range sn,  ( can be uses syntaxly for arrIn() in "neat magic" line. ). Consequtive columns indicies  as simple transpose of consequtive row Indicies from Spreadsheet row Funnction. Row indicies as the consequtive row indicies with the row to be deleted taken out
30   ' so snb does                   arrOut() = Application.Index(sn, rwsT(), clms())
40
50
60  '   clms() = { 1, 2, 3, 4, 5 }
70  'clms()
80   Dim clms() As Variant: Let clms() = Evaluate("column(A1:E10)")
90   Let clms() = Evaluate("column(" & sn.Address & ")")
100  Dim sName As String: Let sName = "snb_002"
110  Let sn.Name = sName
120  Let clms() = Evaluate("column(" & sName & ")")
129  Let clms() = Evaluate("column(snb_002)")
130    '== DANGER: === Pitful: Above we gave the Range Object a Name, but now see what  "Name"  or  "Name" 's  comes back "!"  !
132     Dim retRefstrName As String, retObjName As Object
133     Let retRefstrName = sn.Name: Set retObjName = sn.Name: Debug.Print sn.Name 'something of the form   "NPueyoGyanArraySlicing!$A$1:$E$10" is reveald in Immediate ( Ctrl+G when in VB Editor ) Window
134     'Let clms() = Evaluate("column(=NPueyoGyanArraySlicing!$A$1:$E$10)") 'Let clms() = Evaluate("column(" & retRefstrName & ")")' Rintime Error 13: Incompatiblee types
135     Let clms() = Evaluate("column(NPueyoGyanArraySlicing!$A$1:$E$10)") 'Works
137     Dim NameOnly As String: Let NameOnly = Replace((sn.Name), "!", "", (InStr(1, (sn.Name), "!"))):  'Debug.Print sn.Name: Dim pos&: pos = InStr(1, (sn.Name), "!"): NameOnly = Replace((sn.Name), "!", "", pos) ' We had  ----  "NPueyoGyanArraySlicing!$A$1:$E$10" This is a String referrece returned when the Name Object is used directly or set to a String Variable.     so here I return a string that starts at the position of the ! and which replaces in that truncated shortened string -  "!$A$1:$E$10"   the "!" with nothing
138     Let clms() = Evaluate("column(" & NameOnly & ")"): Let clms() = Evaluate("column(" & Replace((sn.Name), "!", "", (InStr(1, (sn.Name), "!"))) & ")")
139
140     Dim strName As String: Let strName = sn.Name.Name: Debug.Print strName: Let strName = retObjName.Name: Debug.Print strName ' returns our original "CoN"
142     Let clms() = Evaluate("column(" & strName & ")")
150     Dim rngF1G2 As Range: Set rngF1G2 = Range("F1:G2"): Let Range("F1:G2").Value = "From Line 150"
151     Let Range("=NPueyoGyanArraySlicing!F1:G2").Value = "From Line 151"
152     Let rngF1G2.Name = "snFG": Let Range("snFG").Value = "From Line 152"
149    '===============
160 'rwsT()          snb   rws() = VBA.Split(Trim(Replace(" " & Join(Evaluate("transpose(row(A1:E10))")) & " ", " " & y & " ", " ")))
170  'Final required row Indicies, with a missing indicie, as a string ( Hard Copy )
180  Dim strrwsD As String
190  Let strrwsD = "1 2 3 4 6 7 8 9 10"
200  Let strrwsD = Replace("1 2 3 4 5 6 7 8 9 10", " 5 ", " ", 1)
210  Dim strRws As String: Let strRws = "1 2 3 4 5 6 7 8 9 10"
220  Let strrwsD = Replace(strRws, " 5 ", " ", 1)
230
240  'Get full sequential row conveniently from Row Function - ( correct "orientation" to use in "neat magic" code line, but wrong "orientation" to use Join Function {1; 2; 3; 4; 5; 6; 7; 8; 9; 10}  )
250  Dim arr_2D1row() As Variant
260  Let arr_2D1row() = Evaluate("row(A1:E10)") ' 1 To 10, 1 To 1
270
280 'Get full sequential row string.
290  Let strRws = Join(Evaluate("transpose(row(A1:E10))"), " ") 'Join must have eindimensional Array, as given by transpose working on a 2D 1 column Array
300  Let strRws = Join(Application.Transpose((Evaluate("row(A1:E10)"))), " ")
310  Let strRws = Join(Application.Transpose((arr_2D1row())), " ")  '    Join (  Transpose ( { 1; 2; 3; 4; 5; 6; 7; 8; 9; 10} ) ) = Join ( { 1, 2, 3, 4, 5, 6, 7, 8, 9, 10} )
320
330 'Final required row Indicies, with a missing indicie, as a string
340  Let strrwsD = Replace(strRws, " 5 ", " ", 1)
350  Let strrwsD = Replace(strRws, " " & y & " ", " ", 1)
 
360 'Split Final String by " " to get 1 1d "Pseudo Horizontal" Array
370  Dim rws() As String: Let rws() = VBA.Split(strrwsD, " ") ' 1 D Array
380  'Final Transposed Array for "magic neat" code line
390  Dim rwsT() As Variant: Let rwsT() = Application.Transpose(rws()) ' 2 D 1 "column" Array
400
440 'Output Array
450  Dim arrOut() As Variant
460  arrOut() = Application.Index(sn, rwsT(), clms())
470
480  Let Fu_snb = arrOut()
490  'Or
 Let Fu_snb = Application.Index(sn, Application.Transpose(VBA.Split(Replace(Join(Application.Transpose((Evaluate("row(A1:E10)"))), " "), " " & y & " ", " ", 1), " ")), Evaluate("column(A1:E10)"))
'Finally the "extra" named range bit:
 'Let sn.Name = "snb_002"
 Let Fu_snb = Application.Index(sn, Application.Transpose(VBA.Split(Replace(Join(Application.Transpose((Evaluate("row(snb_002)"))), " "), " " & y & " ", " ", 1), " ")), Evaluate("column(snb_002)"))
 ' "Shorthand" evaluate
 Let Fu_snb = Application.Index(sn, Application.Transpose(VBA.Split(Replace(Join(Application.Transpose(([row(snb_002)])), " "), " " & y & " ", " ", 1), " ")), [column(snb_002)])
 'Let Fu_snb = Application.Index(sn, Application.Transpose(VBA.Split(Trim(Replace(" " & Join(Evaluate("transpose(row(snb_002))")) & " ", " " & y & " ", " ")))), Evaluate("column(snb_002)"))
 'or
 'Let Fu_snb = Application.Index(sn, Application.Transpose(Split(Trim(Replace(" " & Join([transpose(row(snb_002))]) & " ", " " & y & " ", " ")))), [column(snb_002)])
End Function

**DocAElstein** · 06-07-2016, 11:52 PM

' To Test Function, Type some arbitrary values in range A1:E10, step through code in F8 Debug Mode in VB Editor, and examine Worksheet, Immediate Window ( Ctrl+G when in VB Editor ), hover over variables in the VB Editor Window with mouse cursor, set watches on variables ( Highlight any occurrence of a variable in the VB Editor and Hit Shift+F9 ) , etc.. and then you should expected the required Output to be pasted out starting Top Left at cell M17

Main Test Code ( Required Function given a couple of Posts down )

Code:

' Delete One Row From A 2D Excel Range Area
' To Test Function, Type some arbitrary values in range A1:E10, step through code in F8 Debug Mode in VB Editor, and examine Worksheet, Immediate Window ( Ctrl+G when in VB Editor ), hover over variables in the VB Editor Window with mouse cursor, set watches on variables ( Highlight  any occurrence of a variable in the VB Editor and Hit Shift+F9 ) , etc.. and then you should expected the required Output to be pasted out starting Top Left at cell M17

Sub Alan()
Dim sp() As Variant
    'Dim DataArr() As Variant: Let DataArr() = Range("A1:E10").Value
 Let sp() = FuR_Alan(Range("A1:E10"), 5)
 'Let sp() = FuRSHg(Range("A1:E10"), 5)
 'Let sp() = FuRSHgDotT(Range("A1:E10"), 5)
 'Let sp() = FuRSHgShtHd(Range("A1:E10"), 5)
 Range("M17").Resize(UBound(sp(), 1), UBound(sp(), 2)).ClearContents
 Let Range("M17").Resize(UBound(sp(), 1), UBound(sp(), 2)) = sp()
End Sub

_............

For no particular reason I am considering this as my Input "Area"

Using Excel 2007 32 bit

_Row\^Col	A	B	C	D	E
1	0	10	20	30	40
2	2	12	22	32	42
3	4	14	24	34	44
4	6	16	26	36	46
5	8	18	28	38	48
6	10	20	30	40	50
7	12	22	32	42	52
8	14	24	34	44	54
9	16	26	36	46	56
10	18	28	38	48	58
11

Sheet: NPueyoGyanArraySlicing

_.......

Expected Output shown in next Post

Thread: VPN Forum access and IP addresse Tests

Thread Tools

Search Thread

Display

VPN Forum access and IP addresse Tests

Problems with Automated Command prompts with VBA

' Delete One Row From a ... group of contiguous cells in a Spreadsheet

Delete One Row From A 2D Excel Range Area

Similar Threads

Table Tests. And Thread Copy Tests No Reply needed

Table Tests. And Thread Copy Tests No Reply needed

New Forum Style

Forum performances

Is that possible to establish between forum page and visual script

Bookmarks

Bookmarks

Posting Permissions

_Row\^Col	A	B	C	D	E
1	0	10	20	30	40
2	2	12	22	32	42
3	4	14	24	34	44
4	6	16	26	36	46
5	8	18	28	38	48
6	10	20	30	40	50
7	12	22	32	42	52
8	14	24	34	44	54
9	16	26	36	46	56
10	18	28	38	48	58
11

_Row\^Col	A	B	C	D	E
1	0	10	20	30	40
2	2	12	22	32	42
3	4	14	24	34	44
4	6	16	26	36	46
5	8	18	28	38	48
6	10	20	30	40	50
7	12	22	32	42	52
8	14	24	34	44	54
9	16	26	36	46	56
10	18	28	38	48	58
11

_Row\^Col	A	B	C	D	E
1	0	10	20	30	40
2	2	12	22	32	42
3	4	14	24	34	44
4	6	16	26	36	46
5	8	18	28	38	48
6	10	20	30	40	50
7	12	22	32	42	52
8	14	24	34	44	54
9	16	26	36	46	56
10	18	28	38	48	58
11