Appendix Thread. ( Codes for other Threads, etc.) Event Coding Drpdown Data validation

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

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

In support of answer to this post
https://excel.tips.net/T001940_Hidin...ell_Value.html

2020-06-19 11:13:59
Erica
This is my script:

Code:

Private Sub Worksheet_Change(ByVal Target As Range) If Target.Column = 3 And Target.Row = 5 Then If Target.Value = "Yes" Then Application.Sheets("FAR").Select Application.Rows("14").Select Application.Selection.EntireRow.Hidden = False Application.Sheets("Additions").Select Application.Rows("6").Select Application.Selection.EntireRow.Hidden = False ElseIf Target.Value = "No" Then Application.Sheets("FAR").Select Application.Rows("14").Select Application.Selection.EntireRow.Hidden = True Application.Sheets("Additions").Select Application.Rows("6").Select Application.Selection.EntireRow.Hidden = True End If End If End Sub

How do I make this continue for the next 19 rows?

The idea is to:
hide row 14 in Tab FAR and Row 7 in Tab Additions if the value in row 6 Tab Additions is "NO" and leave unhidden if yes
hide row 15 in Tab FAR and Row 8 in Tab Additions if the value in row 7 Tab Additions is "NO" and leave unhidden if yes
hide row 16 in Tab FAR and Row 9 in Tab Additions if the value in row 8 Tab Additions is "NO" and leave unhidden if yes

and so fort 20 times

Please can you help me with the reloop of this script ........

Hello Erica
I expect you may have got your macro using the macro recorder? Using the macro recorder is a very good idea as it can easily get you your required syntax and initial coding.
Often we can simplify the macro given by the recorder, in particular bearing in mind that VBA does not need to select or activate things as we do. We have to click on a cell, or row, for example in order to do anything with it. That results in code lines involving Activateing and Selecting. VCBA does not need those actions. Bearing this in mind, and making a few other minor modifications I can simplify your given macro to

Code:

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Column = 3 And Target.Row = 5 Then
        If Target.Value = "Yes" Then
         Let Worksheets("FAR").Rows("14").Hidden = False
         Let Worksheets("Additions").Rows("6").Hidden = False
        ElseIf Target.Value = "No" Then
         Let Worksheets("FAR").Rows("14").Hidden = True
         Let Worksheets("Additions").Rows("6").Hidden = True
        End If
    End If
End Sub

Further to simplify, we can add an initial code line that will limit the most of the macro to running only when a change occurs in the range of interest, which , if I am correct is range C5 to C24 in worksheets Additions
After this, we no longer need to have the check for the column 3
So now we have this

Code:

Private Sub Worksheet_Change(ByVal Target As Range)
    If Application.Intersect(Target, Me.Range("C5:C24")) Is Nothing Then Exit Sub
    If Target.Row = 5 Then        '       Target.Column = 3 And Target.Row = 5 Then
        If Target.Value = "Yes" Then
         Let Worksheets("FAR").Rows("14").Hidden = False
         Let Worksheets("Additions").Rows("6").Hidden = False
        ElseIf Target.Value = "No" Then
         Let Worksheets("FAR").Rows("14").Hidden = True
         Let Worksheets("Additions").Rows("6").Hidden = True
        End If
    End If
End Sub

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

This final version may need a bit of tweaking if you, me, or both of us have muddled up the logic, but I think you can see the general idea

Code:

Private Sub Worksheet_Change(ByVal Target As Range)
    If Application.Intersect(Target, Me.Range("C5:C24")) Is Nothing Then Exit Sub
    If Target.Row = 5 Then        '       Target.Column = 3 And Target.Row = 5 Then
        If Target.Value = "Yes" Then
         Let Worksheets("FAR").Rows("14").Hidden = False
         Let Worksheets("Additions").Rows("6").Hidden = False
        ElseIf Target.Value = "No" Then
         Let Worksheets("FAR").Rows("14").Hidden = True
         Let Worksheets("Additions").Rows("6").Hidden = True
        End If
    End If

' hide row 14 in Tab FAR and Row 7 in Tab Additions if the value in row 6 Tab Additions is "NO" and leave unhidden if yes
' hide row 15 in Tab FAR and Row 8 in Tab Additions if the value in row 7 Tab Additions is "NO" and leave unhidden if yes
' hide row 16 in Tab FAR and Row 9 in Tab Additions if the value in row 8 Tab Additions is "NO" and leave unhidden if yes
' ......and so fort 20 times
    If Target.Row > 5 And Target.Row < 25 Then  ' for rows 6,7,8.....24
        If Target.Value = "No" Then
         Let Worksheets("FAR").Rows("" & Target.Row + 8 & "").Hidden = True
         Let Worksheets("Additions").Rows("" & Target.Row + 1 & "").Hidden = True
        ElseIf Target.Value = "Yes" Then  '  leave unhidden if yes
         Let Worksheets("FAR").Rows("" & Target.Row + 8 & "").Hidden = False
         Let Worksheets("Additions").Rows("" & Target.Row + 1 & "").Hidden = False
        End If
    End If

End Sub

This next version is not too efficient / slower, but might help to see what is going on:

Code:

Private Sub Worksheet_Change(ByVal Target As Range)
    If Application.Intersect(Target, Me.Range("C5:C24")) Is Nothing Then Exit Sub
    If Target.Row = 5 Then        '       Target.Column = 3 And Target.Row = 5 Then
        If Target.Value = "Yes" Then
         Worksheets("FAR").Activate
         Let Worksheets("FAR").Rows("14").Hidden = False
         Worksheets("Additions").Activate
         Let Worksheets("Additions").Rows("6").Hidden = False
        ElseIf Target.Value = "No" Then
         Worksheets("FAR").Activate
         Let Worksheets("FAR").Rows("14").Hidden = True
         Worksheets("Additions").Activate
         Let Worksheets("Additions").Rows("6").Hidden = True
        End If
    End If

' hide row 14 in Tab FAR and Row 7 in Tab Additions if the value in row 6 Tab Additions is "NO" and leave unhidden if yes
' hide row 15 in Tab FAR and Row 8 in Tab Additions if the value in row 7 Tab Additions is "NO" and leave unhidden if yes
' hide row 16 in Tab FAR and Row 9 in Tab Additions if the value in row 8 Tab Additions is "NO" and leave unhidden if yes
' ......and so fort 20 times
    If Target.Row > 5 And Target.Row < 25 Then  ' for rows 6,7,8.....24
        If Target.Value = "No" Then
         Worksheets("FAR").Activate
         Let Worksheets("FAR").Rows("" & Target.Row + 8 & "").Hidden = True
         Worksheets("Additions").Activate
         Let Worksheets("Additions").Rows("" & Target.Row + 1 & "").Hidden = True
        ElseIf Target.Value = "Yes" Then  '  leave unhidden if yes
         Worksheets("FAR").Activate
         Let Worksheets("FAR").Rows("" & Target.Row + 8 & "").Hidden = False
         Worksheets("Additions").Activate
         Let Worksheets("Additions").Rows("" & Target.Row + 1 & "").Hidden = False
        End If
    End If

End Sub

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

kjkjhgjkhjh

test test

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

Obtaining grid coordinates for an Area of contiguous cells in a Spreadsheet using [ ] and Evaluate(“ “) through the use of a Named Range for that Area

Aka ' It is a Range Name Test : Its n Range Name Test : 's 'n Rng Name Test : s n Rg Name Testie : snRg.Name = "snRgNme"

This code is in support of other Posts in various Threads. ( I will edit the Links as I reference this post )
For example:
http://www.excelforum.com/showthread...t=#post4400666

The code takes in a hard coded Range, A1:E10.
That Range is given a Name as held in the Names Register of a Worksheet.
Various code lines are developed which reference this Named Range and return the Grid Coordinates.

These coordinates are held within the following Long Type Variables
Cs is the start column
sClm is the column count
stpClm is the stop column
Rs is the start row
sRw is the rows count
stpRw is the stop row

Code:

'10   ' It is a Range Name Test : Its n Range Name Test : 's 'n Rng Name Test : s n Rg Name Testie : snRg.Name = "snRgNme"
Sub snRgNameTest()  ' Inspired by..   snb     .. " array [     ] "       '  http://www.excelfox.com/forum/showthread.php/2083-Delete-One-Row-From-A-2D-Variant-Array?p=9714#post9714
20    ' Worksheets Info
30    Dim ws As Worksheet '                                      ' Preparing a "Pointer" to an Initial "Blue Print" ( or a Form, or a Questionnaire not yet filled in, a template   etc.) in Memory of the Object ( Pigeon Hole with a bit of paper or code lines on that can be filled in to refer to a specific Object of this type ) . This also us to get easily at the Methods and Properties through the applying of a period ( .Dot) ( intellisense )
40    'Set ws = ThisWorkbook.Worksheets("NPueyoGyanArraySlicing") 'The worksheets collection object is used to Set ws to the Sheet we are playing with, so that we carefull allways referrence this so as not to go astray through Excel Guessing inplicitly not the one we want...              ' Values are filled at the memory locations and the directions there are specified in the variable "Blue Print "Pointer". In this case a Filled in Blue Print is passed.      http://www.excelforum.com/excel-programming-vba-macros/1138804-help-understanding-class-instancing-cant-set-ws-new-worksheet-intellisense-offers-it-4.html#post4387191
50    Set ws = ActiveSheet ' Alternative to last line, make code apply to the current active sheet, - That being "looked at" when running this code        '
60    Dim vTemp As Variant ' To help development when you are not sure what type is retuned. "Suck and see what comnes out!"  Highlight it and Hit Shift+F9 to see it in the imediate Window
70    ' Named range referrencing                                                                                                                                      Invoke  Pike  Evaluate Rabbit Rabbit. How's the Bunny ? Bunnytations Banters
80    Dim snRg As Range: Set snRg = ws.Range("A1:E10")
90    Dim sName As String: Let sName = "snRgNme" '
100   Let snRg.Name = "snRgNme"  ' It is a Range Name me  - " 's 'n Range Name me "  ..  "snRgNme"  ;)  This name appears permanentlly in then sheet. It remains referrencing this range unless the name iis deleted or the range referrenced is overwritten by a similar code line which has a different range in it on RHS of =                                                                                                  http://www.thespreadsheetguru.com/blog/2014/6/20/the-vba-guide-to-listobject-excel-tables
110   Let snRg.Name = sName      ' Identical to last line
120   Dim ReturnedsnRgName As String
130   Let ReturnedsnRgName = snRg.Name ' The returned name is full, like  "NPueyoGyanArraySlicing!$A$1:$E$10". This will not work in the Address Formulas
140   Dim NameOnly As String: Let NameOnly = Replace((snRg.Name), "!", "", (InStr(1, (snRg.Name), "!"))):  Debug.Print snRg.Name: Dim pos&: pos = InStr(1, (snRg.Name), "!"): NameOnly = Replace((snRg.Name), "!", "", pos) ' We had  ----  "NPueyoGyanArraySlicing!$A$1:$E$10"   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
150   Let NameOnly = Replace((ReturnedsnRgName), "!", "", (InStr(1, (ReturnedsnRgName), "!")))
160      If InStr(NameOnly, "!") > 0 Then MsgBox prompt:="NameOnly is " & vbCr & """" & NameOnly & """" & vbCr & "so will chop off up to and including the ""!""": Let NameOnly = Replace((NameOnly), "!", "", (InStr(1, (NameOnly), "!"))) ' Just to demo that you need to do this if you are not sure that a ! is there, or the code line would error if no ! was in there..
170  '
180   ' Count, Start, and Stop of columns in an Area of contiguous cells in a Spreadsheet
190   Dim sClm As Long 'Variable for ColumnsCount.             -This makes a Pigeon Hole sufficient in construction to house a piece of Paper with code text giving the relevant information for the particular Variable Type. VBA is sent to it when it passes it. In a Routine it may be given a particular “Value”, or (“Values” for Objects).  There instructions say then how to do that and handle(store) that(those). At Dim the created Paper is like a Blue Print that has some empty spaces not yet filled in. Long is very simple to handle, final memory "size" type is known (13.456, 00.001 have same "size" computer memory ),so an Address suggestion can be given for when the variable is filled in. (Long is a Big whole Number limit (-2,147,483,648 to 2,147,483,647). If you need some sort of validation the value should only be within the range of a Byte/Integer otherwise there's no point using anything but Long.-upon/after 32-bit, Integers (Short) need converted internally anyway, so a Long is actually faster)
200   Let sClm = Evaluate("columns(snRgNme)") ' = 5
210   'Let sClm = Evaluate("columns(RetunedsnRgName)") 'Run time Error as expected
220   Let sClm = [columns(snRgNme)]           ' = 5              'Is this Most Powerful Command in VBA?, or what ...    http://www.ozgrid.com/forum/showthread.php?t=52372       http://www.mrexcel.com/forum/excel-questions/899117-visual-basic-applications-range-a1-a5-vs-%5Ba1-a5%5D-benefits-dangers.html
230   'Let sClm = [columns(RetunedsnRgName)]           'Run time Error as expected
240   Let sClm = [columns(A1:E10)]             ' = 5
250                                                               Let vTemp = Evaluate("column(snRgNme)") ' Reveals an Array {1, 2, 3, 4, 5}  -  1 Dimension "pseudo Horizontal" Array
260   Dim Cs As Long 'Variable for Start Column
270   Let Cs = Evaluate("column(A1:E10)")(1)
280   Let Cs = Evaluate("column(snRgNme)")(1) ' = 1
290                                                               Let vTemp = [column(snRgNme)]: vTemp = vTemp(1) ' Anololie erklart:   http://www.excelforum.com/showthread.php?t=1141369&p=4398930&highlight=#post4398930    http://www.excelforum.com/showthread.php?t=1141369&p=4398966#post4398966
300   Let Cs = [column(A1:E10)]()(1)
310   Let Cs = [column(snRgNme)]()(1)
320   '
330   Dim stpClm% ' Variable for Stop column Number               '  ( % is shorthand for As Long ..http://www.excelforum.com/showthread.php?t=1116127&p=4256569#post4256569
340   Let stpClm = Cs + (sClm - 1)             ' = 5
350   ' [ ]
360   Let stpClm = [column(snRgNme)]()(1) + ([columns(snRgNme)] - 1)
370   Let stpClm = [column(snRgNme)]()(1) + ([columns(snRgNme)] - 1)
380   ' In between step [ ] and Evaluate(" ")
390   Let stpClm = [column(snRgNme)]()(UBound([column(snRgNme)]))
400   ' Now Full Evaluate(" ")
410   Let stpClm = Evaluate("column(snRgNme)")(1) + (Evaluate("columns(snRgNme)") - 1)
420   Let stpClm = Evaluate("column(snRgNme)")(UBound(Evaluate("column(snRgNme)")))
430  '
440   ' Start, Count and Stop of rows in an Area of contiguous cells in a Spreadsheet
450   Dim sRw As Long 'Rows Count
460   Let sRw = Evaluate("rows(snRgNme)")
470   Let sRw = [rows(snRgNme)]
480   Let sRw = [rows(A1:E10)]
490                                                               Let vTemp = Evaluate("row(snRgNme)") ' = {1; 2; 3; 4; 5; 6; 7; 8; 9; 10}
500   Dim Rs As Long 'Start Row
510   Let Rs = Evaluate("row(A1:E10)")(1, 1) 'Note a 2 Dimensional,  1 column, "vertical" Array is returned : ' vTemp = {1; 2; 3; 4; 5; 6; 7; 8; 9; 10}
520   Let Rs = Evaluate("row(snRgNme)")(1, 1)
530                                                               Let vTemp = [row(snRgNme)]: vTemp = vTemp(1, 1)
540   Let Rs = [row(A1:E10)]()(1, 1)
550   Let Rs = [row(snRgNme)]()(1, 1)
560  '
570   Dim stpRw% 'Stop Row
580   Let stpRw = Rs + (sRw - 1)
590   Let stpRw = [row(snRgNme)]()(1, 1) + ([rows(snRgNme)] - 1)
600   Let stpRw = [row(snRgNme)]()(1, 1) + ([rows(snRgNme)] - 1)
610  '
620   Let stpRw = [row(snRgNme)]()(UBound([row(snRgNme)], 1), 1) 'UBound([row(snRgNme)], 1) is Ubound first ( "row" ) dimension.  UBound([row(snRgNme)], 2) would be the second dimension ( "column" ) count
630  '
640   Let stpRw = Evaluate("row(snRgNme)")(1, 1) + (Evaluate("rows(snRgNme)") - 1)
650   Let stpRw = Evaluate("row(snRgNme)")(UBound(Evaluate("row(snRgNme)")), 1)
660  '
End Sub

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

"Opened up" Rick code:

' To Test Function, Type some arbitrary values in range A1:E10, step through Test 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

(_... Original Code:
' http://www.excelfox.com/forum/showth...=9658#post9658
....)

Code:

' To Test Function, Type some arbitrary values in range A1:E10, step through Test 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=9658#post9658
Sub Rick()
Dim sp() As Variant
Dim DataArr() As Variant: Let DataArr() = Range("A1:E10").Value
 Let sp() = Fu_Rick(DataArr(), 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_Rick(ByRef arrIn() As Variant, ByVal RowToDelete As Long) As Variant
_... in next Post

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

Function Required for last Post:

Code:

Function Fu_Rick(ByRef arrIn() As Variant, ByVal RowToDelete As Long) As Variant
10  ' use "neat magic" code line    arrOut() = Application.Index(arrIn(), rwsT(), clms())
20  ' So we have directly the Input Array, arrIn(). For clms(), do some extra stuff to get a column letter ( usiing the Split Address Method ) then column indices diectly from Spreadsheet column() Function. Rows from joinig the Row indicies above and below the row to be deleted
30                                          Dim Cols As String: Cols = "A:" & Split(Columns(UBound(arrIn(), 2) - LBound(arrIn(), 2) + 1).Address(, 0), ":")(0)
40  '                                       Fu_Rick = Application.Index(arrIn(), Application.Transpose(Split(Join(Application.Transpose(Evaluate("Row(1:" & (RowToDelete - 1) & ")"))) & " " & Join(Application.Transpose(Evaluate("Row(" & (RowToDelete + 1) & ":" & UBound(arrIn()) & ")"))))), Evaluate("COLUMN(" & Cols & ")"))
50
60  '   clms() = { 1, 2, 3, 4, 5 }
61  'clms()   Rick     Evaluate("COLUMN(" & "A:" & Split(Columns(UBound(arrIn(), 2) - LBound(arrIn(), 2) + 1).Address(, 0), ":")(0) & ")")
70   '  Start point is last column in Output Array using..   Split Address technique     http://www.excelforum.com/development-testing-forum/1101544-thread-post-appendix-no-reply-needed-please-do-not-delete-thanks-4.html#post4213969
80   Dim larrClm As Long: Let larrClm = ((UBound(arrIn(), 2) - LBound(arrIn(), 2)) + 1) ' For our Output Array  ( base 1 ) staring at 1 - not yet pinned to a Top left Output Range cell the ( ( stop "column"  - start "column" ) + 1 ) gives "last" "column"
90   Dim AdrsRel As String: Let AdrsRel = Columns(larrClm).Address(ColumnAbsolute:=False) 'False absolute Address gives no $ prefix and format like "E:E" (true Relative Address) , so split by ":" and then either (0) or (1) returned arrAddressSplit() Element will do for the letter..
100  Dim arrAddressSplit() As String
110  Let arrAddressSplit() = VBA.Split(AdrsRel, ":", 2, vbTextCompare) 'Splits  into like ("E", "E") for no or -1 second argument..  Here 2 gives just the 2 you would get E, and E - ...   http://www.mrexcel.com/forum/general-excel-discussion-other-questions/929381-visual-basic-applications-split-function-third-argument-refers-maximum-outputs-%93when-splitting-stops-%94.html
120  Dim clmLtr As String
130  Let clmLtr = arrAddressSplit(0) 'Returns first element "along" in 1 Dimensional "Psuedo Horizontal" Array ( Elements for 1 Dimensional Array are by default 0,1, 2, 3 ....etc )
140  ' Now use spreadsheet column function , column(A:E"), to get a {1, 2, 3, 4, 5} Array
150  Dim clms() As Variant: Let clms() = Evaluate("column(A:" & clmLtr & ")")
 
160  'rwsT()       Rick       Application.Transpose(Split(Join(Application.Transpose(Evaluate("Row(1:" & (RowToDelete - 1) & ")"))) & " " & Join(Application.Transpose(Evaluate("Row(" & (RowToDelete + 1) & ":" & UBound(arrIn()) & ")")))))
170  'Final required row Indicies, with a missing indicie, as 2 strings ( Hard Copy )
180  Dim strRwsDBelow As String, strRwsDAbove As String, strrwsD As String
190  Let strRwsDBelow = "1 2 3 4": Let strRwsDAbove = "6 7 8 9 10"
200  Let strrwsD = "1 2 3 4" & " " & "6 7 8 9 10"
210  Let strrwsD = strRwsDBelow & " " & strRwsDAbove
220
230
240  'Get row indicies conveniently from Row Function - ( correct "orintation" to use in "neat magic" code line, but wrong "orientation" to use Join Function {1; 2; 3; 4}   and   {6; 7; 8; 9; 10}  )
250  Dim arr_2D1rowBelow() As Variant, arr_2D1rowAbove() As Variant
260  Let arr_2D1rowBelow() = Evaluate("Row(1:" & (RowToDelete - 1) & ")") ' 1 To 4, 1 To 1 {1; 2; 3; 4} Array
270  Let arr_2D1rowAbove() = Evaluate("Row(" & (RowToDelete + 1) & ":" & UBound(arrIn()) & ")") ' 1 To 5, 1 To 1 {6; 7; 8; 9; 10} Array
280  'Get sequential below and above  row strings....   transpose back again! so Join will work, dear oh dear.....
290  Let strRwsDBelow = Join(Evaluate("transpose(Row(1:" & (RowToDelete - 1) & "))"), " ") 'Join must have eindimensional Array, as given by transpose working on a 2D 1 column Array
300  Let strRwsDBelow = Join(Application.Transpose((Evaluate("Row(1:" & (RowToDelete - 1) & ")"))), " ") '   "1 2 3 4"
310  Let strRwsDBelow = Join(Application.Transpose((arr_2D1rowBelow())), " ") '   "1 2 3 4"
320  Let strRwsDAbove = Join(Application.Transpose((arr_2D1rowAbove())), " ") '   "6 7 8 9 10"
  
330 'Final required row Indicies, with a missing indicie, as a string
340  Let strrwsD = strRwsDBelow & " " & strRwsDAbove
350
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 Let arrOut() = Application.Index(arrIn(), rwsT(), clms())
470
480 Let Fu_Rick = arrOut()
490 'Or
 Fu_Rick = Application.Index(arrIn(), Application.Transpose(Split(Join(Application.Transpose(Evaluate("Row(1:" & (RowToDelete - 1) & ")"))) & " " & Join(Application.Transpose(Evaluate("Row(" & (RowToDelete + 1) & ":" & UBound(arrIn()) & ")"))))), Evaluate("COLUMN(" & "A:" & Split(Columns(UBound(arrIn(), 2) - LBound(arrIn(), 2) + 1).Address(, 0), ":")(0) & ")"))
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

**DocAElstein** · 06-26-2016, 10:27 PM

More Named Range Scope Wonks. Problems when Worksheet Scoped WorkSheet is different from Worksheet refered to in RefersTo:= Range Object argument

Here is a another partial solution to the This Thread
http://www.excelforum.com/excel-prog...acket-for.html

It was also used to answer a few questions I had here:
http://www.thespreadsheetguru.com/bl...o-named-ranges[I][COLOR="#000080"] ( Comment 22 )
Here is what I wrote there:
Reply Posted at
http://www.thespreadsheetguru.com/bl...o-named-ranges
6 th June 2016:

Hi
Hi Just feeding back from my "experiments" over the weekend_...
http://www.excelforum.com/showthread...t=#post4404276
_..So now o answer my questions:
_1) I have not yet seen anything to suggest the answer to that is not yes.

**DocAElstein** · 05-13-2018, 02:28 PM

To support solution to this Thread:
http://www.excelfox.com/forum/showth...and-send-email

Test data supplied by Thainguyen for this Thread :
http://www.excelfox.com/forum/showth...and-send-email

Code:

Using Excel 2007 32 bit
_Row\^Col
A
B
C
D
E
F
G
H
I
J
K
N

1
Equipment PM












2
Machine EQ.ID
Manufacture
Model
Description
Serial Number
Weekly
 Date of Service
Weekly
 Next Service 
Monthly
Date of Service
Monthly 
Next  Service
Quarterly
Date of Service
Quarterly 
Next Service
Softwear 

3













4
1
JUKI
GKG GL
GL SCREEN PRINTER
A123
06.04.2018
13.04.2018
15.03.2018
12.04.2018
N/A
N/A


5
2
JUKI
KE-1070L
SMT Placement Machine
A124
11.04.2018
18.04.2018
28.03.2018
25.04.2018
N/A
N/A


6
9
ACE Production
KISS-101B
Selective  Wave Solder
A125
06.04.2018
13.04.2018
15.03.2018
12.04.2018
N/A
N/A


7
59
Heller
1826 MK5
Reflow Oven
A126
N/A
N/A
16.03.2018
13.04.2018
N/A
N/A


8
62
Exit Sign -- N/A -- Exit Lights
N/A
N/A
A127
N/A
N/A
N/A
N/A
N/A
N/A


9
69
South-Tek System
N2-Gen 35ST
Nitrogen Generator
A128
10.04.2018
17.04.2018
N/A
N/A
09.03.2018
06.04.2018


10
75
ACE Production
KISS-102
Selective  Wave Solder
A129
16.04.2018
23.04.2018
N/A
N/A
N/A
N/A


11
101
FKN system
N100 Nibbler
Dispensing
A130
N/A
N/A
N/A
N/A
04.04.2018
02.05.2018


12
109
Mycronic
MY200sx
SMT Machine
A131
N/A
N/A
N/A
N/A
N/A
N/A


13
112
X-TEK
XTV-160
X-Ray System
A132
N/A
N/A
N/A
N/A
N/A
N/A


14
113
MIRTEC
MV-6 OMNI
AOI
A133
N/A
N/A
N/A
N/A
N/A
N/A


15
116
JUKI
KE-2060RL
SMT Placement Machine
A134
N/A
N/A
N/A
N/A
N/A
N/A


16
127
ELGI
EG22-150
Air Compressor
A135
N/A
N/A
N/A
N/A
N/A
N/A


17
128
Juki
KE-2050
SMT
A136
N/A
N/A
N/A
N/A
N/A
N/A


18
137
Juki
K3
Screen printer
A137
06.04.2018
13.04.2018
N/A
N/A
N/A
N/A


19
141
Heller
1826 MK5
Reflow Oven
A138
N/A
N/A
N/A
N/A
N/A
N/A


20
142
NISSAN
MCU-112A331.V
Forklift
A139
N/A
N/A
N/A
N/A
15.02.2018
15.03.2018


21
142
NISSAN/yearly oil change and lube
MCU-112A331.V
Forklift
A140
N/A
N/A
N/A
N/A
N/A
N/A


22










28.01.1900


23














Worksheet: Equipment PM

Thread: Appendix Thread. ( Codes for other Threads, etc.) Event Coding Drpdown Data validation

Thread Tools

Search Thread

Display

Hybrid View

Appendix Thread. ( Codes for other Threads, etc.) Event Coding Drpdown Data validation

Grid coordinates for a Range using [ ] and Evaluate(" ") through a named Range

' Delete One Row From A 2D Variant Array

Delete One Row From A 2D Excel Range Area

Test data supplied by Thainguyen

Similar Threads

Appendix Thread 2. ( Codes for other Threads, HTML Tables, etc.)

Appendix Thread. ( Codes for other Threads, ( Avinash ).)

Appendix Thread. Diet Protokol Coding Adaptions

Restrict data within the Cell (Data Validation)

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	F	G	H	I	J	K	N
1	Equipment PM
2	Machine EQ.ID	Manufacture	Model	Description	Serial Number	Weekly Date of Service	Weekly Next Service	Monthly Date of Service	Monthly Next Service	Quarterly Date of Service	Quarterly Next Service	Softwear
3
4	1	JUKI	GKG GL	GL SCREEN PRINTER	A123	06.04.2018	13.04.2018	15.03.2018	12.04.2018	N/A	N/A
5	2	JUKI	KE-1070L	SMT Placement Machine	A124	11.04.2018	18.04.2018	28.03.2018	25.04.2018	N/A	N/A
6	9	ACE Production	KISS-101B	Selective Wave Solder	A125	06.04.2018	13.04.2018	15.03.2018	12.04.2018	N/A	N/A
7	59	Heller	1826 MK5	Reflow Oven	A126	N/A	N/A	16.03.2018	13.04.2018	N/A	N/A
8	62	Exit Sign -- N/A -- Exit Lights	N/A	N/A	A127	N/A	N/A	N/A	N/A	N/A	N/A
9	69	South-Tek System	N2-Gen 35ST	Nitrogen Generator	A128	10.04.2018	17.04.2018	N/A	N/A	09.03.2018	06.04.2018
10	75	ACE Production	KISS-102	Selective Wave Solder	A129	16.04.2018	23.04.2018	N/A	N/A	N/A	N/A
11	101	FKN system	N100 Nibbler	Dispensing	A130	N/A	N/A	N/A	N/A	04.04.2018	02.05.2018
12	109	Mycronic	MY200sx	SMT Machine	A131	N/A	N/A	N/A	N/A	N/A	N/A
13	112	X-TEK	XTV-160	X-Ray System	A132	N/A	N/A	N/A	N/A	N/A	N/A
14	113	MIRTEC	MV-6 OMNI	AOI	A133	N/A	N/A	N/A	N/A	N/A	N/A
15	116	JUKI	KE-2060RL	SMT Placement Machine	A134	N/A	N/A	N/A	N/A	N/A	N/A
16	127	ELGI	EG22-150	Air Compressor	A135	N/A	N/A	N/A	N/A	N/A	N/A
17	128	Juki	KE-2050	SMT	A136	N/A	N/A	N/A	N/A	N/A	N/A
18	137	Juki	K3	Screen printer	A137	06.04.2018	13.04.2018	N/A	N/A	N/A	N/A
19	141	Heller	1826 MK5	Reflow Oven	A138	N/A	N/A	N/A	N/A	N/A	N/A
20	142	NISSAN	MCU-112A331.V	Forklift	A139	N/A	N/A	N/A	N/A	15.02.2018	15.03.2018
21	142	NISSAN/yearly oil change and lube	MCU-112A331.V	Forklift	A140	N/A	N/A	N/A	N/A	N/A	N/A
22											28.01.1900
23

_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