Appendix Thread. 3 TEST COPY

**DocAElstein** · 04-26-2022, 06:18 PM

Spare post for later

_Row\^Col	A	B	C
1	Numbers	ID	Date
2	12345	22	01/03/2022
3	12345	22	01/03/2022
4	12345	22	01/03/2022
5	12345	22	01/03/2022
6	12345	22	01/05/2022
7	12345	22	01/05/2022
8	12345	22	01/06/2022
9	12345	22	01/06/2022
10	12345	22	04/02/2022
11	12345	22	04/02/2022
12	12345	22	04/02/2022
13	12345	22	04/03/2022
14	12345	22	04/03/2022
15	12345	22	04/04/2022
16	23456	22	01/03/2022
17	23456	22	01/03/2022
18	23456	22	01/03/2022
19	23456	22	01/04/2022
20	23456	22	01/04/2022
21

Worksheet: Data

And this is your results.

_Row\^Col	A	B	C	D	E	F	G
1	Number	ID	Start Date	End Date	Days	Working Days
2	12345	22	01/03/2022	04/04/2022	92	64	Incorrect
3	23456	22	01/03/2022	01/04/2022	2	1
4
5
6
7	12345	22	01/03/2022	01/06/2022	4	3	Correct
8	12345	22	04/02/2022	04/04/2022	3	0

Worksheet: Result

It is impossible to understand why you have more than one result for 12345

**DocAElstein** · 04-26-2022, 06:40 PM

Following on from posts,
https://excelfox.com/forum/showthrea...ll=1#post16530 https://excelfox.com/forum/showthrea...ll=1#post16529
http://www.eileenslounge.com/viewtop...294692#p294692
,

The header row,
Group Amount1 Amount2 Amount3 Amount4 Notes1 Notes2 Notes3 Notes4 Name
, we could make partially dynamic, as is needed, since we don’t know the maximum number of amounts ( = maximum number of Notes ) , before seeing the data.

We do have the information needed, since Mx contains, in our current example, the required value of 4

Evaluate Range techniques are a convenient way to get these sort of things.

We start by considering spreadsheet formulas such as this,
={"Amount" & COLUMN(A1:D1)}
, which returns us an array, which applied across a range , would give us like
Amount1 Amount2 Amount3 Amount4

Taking that general idea and a few other steps we can finally get at our heading like in this demo coding

Code:

' https://excelfox.com/forum/showthread.php/2345-Appendix-Thread-(-Codes-for-other-Threads-HTML-Tables-etc-)?p=16532&viewfull=1#post16532
Sub MakeHeadings()
Dim Mx As Long: Let Mx = 4
Dim Amounts() As Variant
 Let Amounts() = Evaluate("=""Amount"" & COLUMN(A1:D1)")
 Let Amounts() = Evaluate("=""Amount"" & COLUMN(A:D)")
 Let Amounts() = Evaluate("=""Amount"" & COLUMN(A:" & "D" & ")")
' We need to get   D  from what we know,  Mx
Dim vTemp As Variant
 vTemp = Cells(1, 4).Address
 vTemp = Split(vTemp, "$", 3, vbBinaryCompare)
 vTemp = vTemp(1)
' Or
 vTemp = Split(Cells(1, 4).Address, "$", 3, vbBinaryCompare)(1)
' Or
 vTemp = Split(Cells(1, 4).Address, "$")(1)
 vTemp = Split(Cells(1, Mx).Address, "$")(1)

Let Amounts() = Evaluate("=""Amount"" & COLUMN(A:" & vTemp & ")")
Let Amounts() = Evaluate("=""Amount"" & COLUMN(A:" & Split(Cells(1, Mx).Address, "$")(1) & ")")
'
' We want this array as a string with   vbTabs seperating the array elements
Dim strAmounts As String
 Let strAmounts = Join(Amounts(), vbTab)
 Let strAmounts = Join(Evaluate("=""Amount"" & COLUMN(A:" & Split(Cells(1, Mx).Address, "$")(1) & ")"), vbTab)

' similarly for the  notes
Dim strNotes As String
 Let strNotes = Join(Evaluate("=""Note"" & COLUMN(A:" & Split(Cells(1, Mx).Address, "$")(1) & ")"), vbTab)

' To get our final heading string,
Dim strHd As String
 Let strHd = "Group" & vbTab & Join(Evaluate("=""Amount"" & COLUMN(A:" & Split(Cells(1, Mx).Address, "$")(1) & ")"), vbTab) & vbTab & Join(Evaluate("=""Note"" & COLUMN(A:" & Split(Cells(1, Mx).Address, "$")(1) & ")"), vbTab) & vbTab & "Notes"

Dim objDataObject As Object: Set objDataObject = GetObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")   '     http://web.archive.org/web/20200124185244/http://excelmatters.com/2013/10/04/late-bound-msforms-dataobject/
 objDataObject.SetText Text:=strHd
 objDataObject.PutInClipboard
Dim Ws1 As Worksheet: Set Ws1 = ThisWorkbook.Worksheets("Sheet1")
 Ws1.Paste Destination:=Ws1.Range("G1")

End Sub

In the next post , https://excelfox.com/forum/showthrea...ll=1#post16533 , is that integrated into the main coding in Rem 3

**DocAElstein** · 04-26-2022, 07:40 PM

Coding for these posts
https://excelfox.com/forum/showthrea...ll=1#post16532

Code:

Sub Stantially()
Rem 0 data
Dim Ws1 As Worksheet: Set Ws1 = ThisWorkbook.Worksheets("Sheet1")
Dim RngPlus1 As Range
 Set RngPlus1 = Ws1.Cells.Item(1).CurrentRegion.Resize(Ws1.Cells.Item(1).CurrentRegion.Rows.Count + 1, Ws1.Cells.Item(1).CurrentRegion.Columns.Count)
Dim vArr() As Variant: Let vArr() = RngPlus1.Value2
Rem 1 determine the biggest group ( that maximum Amounts or Notes count )
Dim Cnt As Long, Cnt2 As Long, Mx As Long: Let Mx = 1: Let Cnt = 1
    Do  '            ############################# Main Outer Loop keeps us going through all data rows
        Do  '                           -----------------  Inner Loop that takes us through a group
         Let Cnt = Cnt + 1 ' Cnt is the main data row number
         Let Cnt2 = Cnt2 + 1
        Loop While vArr(Cnt + 1, 1) = vArr(Cnt, 1) ' ----  Inner Loop that takes us through a group
        If Cnt2 > Mx Then Let Mx = Cnt2
     Let Cnt2 = 0
    Loop While Cnt < UBound(vArr(), 1) - 1 '  #### Main Outer Loop keeps us going through all data rows

Rem 2 '            ############################# Main Outer Loop keeps us going through all data rows
 Let Cnt = 1
    Do
    Dim HrCnt As Long: Let HrCnt = 1
    Dim strClipR As String, strClipL As String: Let strClipL = strClipL & vArr(Cnt + 1, 1)
        Do                                         '2a The first inner loop
         Let Cnt = Cnt + 1
         Let HrCnt = HrCnt + 1
         Let strClipL = strClipL & vbTab & vArr(Cnt, 2)
         Let strClipR = strClipR & vbTab & vArr(Cnt, 3)
        Loop While vArr(Cnt + 1, 1) = vArr(Cnt, 1) '   The first inner loop
        Do While HrCnt < Mx + 1                    '2b the second inner loop
         Let strClipL = strClipL & vbTab
         Let strClipR = strClipR & vbTab
         Let HrCnt = HrCnt + 1
        Loop                                       '   the second inner loop
    '2c Finishing off the strings, and final string for an output line, after the inner loops
     Let strClipR = strClipR & vbTab & vArr(Cnt, 4) ' add the group name
    Dim strClip As String: Let strClip = strClip & strClipL & strClipR & vbCr & vbLf  ' join the strings and add a line seperator to the output row string
    'Call WtchaGot_Unic_NotMuchIfYaChoppedItOff(strClip)
    Let strClipL = "": strClipR = ""
    Loop While Cnt < UBound(vArr(), 1) - 1 '  #### Main Outer Loop keeps us going through all data rows
 'Call WtchaGot_Unic_NotMuchIfYaChoppedItOff(strClip)
'2d paste  strClip  out via the windows Clipboard
Dim objDataObject As Object: Set objDataObject = GetObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")   '     http://web.archive.org/web/20200124185244/http://excelmatters.com/2013/10/04/late-bound-msforms-dataobject/
 objDataObject.SetText Text:=strClip
 objDataObject.PutInClipboard
 Ws1.Paste Destination:=Ws1.Range("G2")

Rem 3 headers
Dim strHd As String
 Let strHd = "Group" & vbTab & Join(Evaluate("=""Amount"" & COLUMN(A:" & Split(Cells(1, Mx).Address, "$")(1) & ")"), vbTab) & vbTab & Join(Evaluate("=""Note"" & COLUMN(A:" & Split(Cells(1, Mx).Address, "$")(1) & ")"), vbTab) & vbTab & "Name"
 objDataObject.SetText Text:=strHd
 objDataObject.PutInClipboard
 Ws1.Paste Destination:=Ws1.Range("G1")

End Sub

**DocAElstein** · 06-17-2022, 02:10 AM

Some extra notes for this main forum post:
http://www.eileenslounge.com/viewtopic.php?f=27&t=38331

This is a sample input,

_____ Workbook: Split- Copy.xlsm ( Using Excel 2007 32 bit )

_Row\^Col	A	B
2	1,2,3,4	t,y,u,m

Worksheet: Sheet2Original

This is what I want out

_____ Workbook: Split- Copy.xlsm ( Using Excel 2007 32 bit )

_Row\^Col	A	B
2	1	t
3	2	y
4	3	u
5	4	m

Worksheet: Sheet2

I want to do this sort of thing,

__ arrOut()= App.Index(arrIn(), Rws(), Clms())

The arrIn() in this case will be all the input data. Conveniently, we can join the two cell values with a comma then split all that by comma to get a single array, {1 2 3 4 t y u m }
Then we need the Rws() like this
1 1
1 1
1 1
1 1
and the Clms() like this
1 5
2 6
3 7
4 8

Code:

'  https://excelfox.com/forum/showthread.php/2345-Appendix-Thread-(-Codes-for-other-Threads-HTML-Tables-etc-)?p=16639&viewfull=1#post16639
Sub SplitData4()
Dim Ws2 As Worksheet: Set Ws2 = ThisWorkbook.Worksheets.Item("Sheet2")
Dim strDta As String: Let strDta = Ws2.Range("A2").Value & "," & Ws2.Range("B2").Value
Dim arrIn() As String
 Let arrIn() = Split(strDta, ",", -1, vbBinaryCompare)
' Or
 arrIn() = Split(Range("A2").Value & "," & Range("B2").Value, ",")
Dim Rws() As Variant
 Let Rws() = Evaluate("=Row(1:4)/Row(1:4)*Column(A:B)/Column(A:B)")
 Let Rws() = Evaluate("=Row(1:" & (UBound(arrIn()) + 1) / 2 & ")/Row(1:" & (UBound(arrIn()) + 1) / 2 & ")*Column(A:B)/Column(A:B)")
Dim Clms() As Variant
 Let Clms() = Evaluate("=Row(1:4)+((Column(A:B)-1)*" & (UBound(arrIn()) + 1) / 2 & ")")
 Let Clms() = Evaluate("=Row(1:" & (UBound(arrIn()) + 1) / 2 & ")+((Column(A:B)-1)*" & (UBound(arrIn()) + 1) / 2 & ")")

Dim arrOut() As Variant
 Let arrOut() = Application.Index(arrIn(), Rws(), Clms())

 Let Ws2.Range("A2").Resize((UBound(arrIn()) + 1) / 2, 2).Value = arrOut()

' Or
' Range("A2").Resize((UBound(arrIn()) + 1) / 2, 2).Value = arrOut()
' Range("A2").Resize((UBound(arrIn()) + 1) / 2, 2).Value = Application.Index(arrIn(), Rws(), Clms())
' Range("A2").Resize((UBound(arrIn()) + 1) / 2, 2).Value = Application.Index(arrIn(), Evaluate("=Row(1:" & (UBound(arrIn()) + 1) / 2 & ")/Row(1:" & (UBound(arrIn()) + 1) / 2 & ")*Column(A:B)/Column(A:B)"), Evaluate("=Row(1:" & (UBound(arrIn()) + 1) / 2 & ")+((Column(A:B)-1)*" & (UBound(arrIn()) + 1) / 2 & ")"))

 Range("A2").Resize((UBound(Split(Range("A2").Value & "," & Range("B2").Value, ",")) + 1) / 2, 2).Value = Application.Index(Split(Range("A2").Value & "," & Range("B2").Value, ","), Evaluate("=Row(1:" & (UBound(Split(Range("A2").Value & "," & Range("B2").Value, ",")) + 1) / 2 & ")/Row(1:" & (UBound(Split(Range("A2").Value & "," & Range("B2").Value, ",")) + 1) / 2 & ")*Column(A:B)/Column(A:B)"), Evaluate("=Row(1:" & (UBound(Split(Range("A2").Value & "," & Range("B2").Value, ",")) + 1) / 2 & ")+((Column(A:B)-1)*" & (UBound(Split(Range("A2").Value & "," & Range("B2").Value, ",")) + 1) / 2 & ")"))
 
End Sub

Code:

Sub StantiallyBeautiful() '  http://www.eileenslounge.com/viewtopic.php?f=27&t=38331
 Range("A2").Resize((UBound(Split(Range("A2").Value & "," & Range("B2").Value, ",")) + 1) / 2, 2).Value = Application.Index(Split(Range("A2").Value & "," & Range("B2").Value, ","), Evaluate("=Row(1:" & (UBound(Split(Range("A2").Value & "," & Range("B2").Value, ",")) + 1) / 2 & ")/Row(1:" & (UBound(Split(Range("A2").Value & "," & Range("B2").Value, ",")) + 1) / 2 & ")*Column(A:B)/Column(A:B)"), Evaluate("=Row(1:" & (UBound(Split(Range("A2").Value & "," & Range("B2").Value, ",")) + 1) / 2 & ")+((Column(A:B)-1)*" & (UBound(Split(Range("A2").Value & "," & Range("B2").Value, ",")) + 1) / 2 & ")"))
End Sub

In actual fact, we can simplify things a bit , since Intersexual interception theory tells us that if Excel is looking for the indicies of this form
A b
C d
E f
G h
, but we only give it
1
, then it will see this instead
1 1
1 1
1 1
1 1

So that means we can replace Rws() with just 1
So that all simplifies it a bit…

Code:

Sub SplitData4b()
Dim Ws2 As Worksheet: Set Ws2 = ThisWorkbook.Worksheets.Item("Sheet2")
Dim strDta As String: Let strDta = Ws2.Range("A2").Value & "," & Ws2.Range("B2").Value
Dim arrIn() As String
 Let arrIn() = Split(strDta, ",", -1, vbBinaryCompare)
' Or
 arrIn() = Split(Range("A2").Value & "," & Range("B2").Value, ",")
'Dim Rws() As Variant
' Let Rws() = Evaluate("=Row(1:4)/Row(1:4)*Column(A:B)/Column(A:B)")
' Let Rws() = Evaluate("=Row(1:" & (UBound(arrIn()) + 1) / 2 & ")/Row(1:" & (UBound(arrIn()) + 1) / 2 & ")*Column(A:B)/Column(A:B)")
Dim Clms() As Variant
 Let Clms() = Evaluate("=Row(1:4)+((Column(A:B)-1)*" & (UBound(arrIn()) + 1) / 2 & ")")
 Let Clms() = Evaluate("=Row(1:" & (UBound(arrIn()) + 1) / 2 & ")+((Column(A:B)-1)*" & (UBound(arrIn()) + 1) / 2 & ")")

Dim arrOut() As Variant
' Let arrOut() = Application.Index(arrIn(), Rws(), Clms())
 Let arrOut() = Application.Index(arrIn(), 1, Clms())
 Let Ws2.Range("A2").Resize((UBound(arrIn()) + 1) / 2, 2).Value = arrOut()

' Or
' Range("A2").Resize((UBound(arrIn()) + 1) / 2, 2).Value = arrOut()
' Range("A2").Resize((UBound(arrIn()) + 1) / 2, 2).Value = Application.Index(arrIn(), 1, Clms())
' Range("A2").Resize((UBound(arrIn()) + 1) / 2, 2).Value = Application.Index(arrIn(), 1, Evaluate("=Row(1:" & (UBound(arrIn()) + 1) / 2 & ")+((Column(A:B)-1)*" & (UBound(arrIn()) + 1) / 2 & ")"))

 Range("A2").Resize((UBound(Split(Range("A2").Value & "," & Range("B2").Value, ",")) + 1) / 2, 2).Value = Application.Index(Split(Range("A2").Value & "," & Range("B2").Value, ","), 1, Evaluate("=Row(1:" & (UBound(Split(Range("A2").Value & "," & Range("B2").Value, ",")) + 1) / 2 & ")+((Column(A:B)-1)*" & (UBound(Split(Range("A2").Value & "," & Range("B2").Value, ",")) + 1) / 2 & ")"))
End Sub

Sub StantiallyBeautifulb() '  http://www.eileenslounge.com/viewtopic.php?f=27&t=38331
 Range("A2").Resize((UBound(Split(Range("A2").Value & "," & Range("B2").Value, ",")) + 1) / 2, 2).Value = Application.Index(Split(Range("A2").Value & "," & Range("B2").Value, ","), 1, Evaluate("=Row(1:" & (UBound(Split(Range("A2").Value & "," & Range("B2").Value, ",")) + 1) / 2 & ")+((Column(A:B)-1)*" & (UBound(Split(Range("A2").Value & "," & Range("B2").Value, ",")) + 1) / 2 & ")"))
End Sub

**DocAElstein** · 06-22-2022, 12:42 PM

some more notes on it....

later.....

**DocAElstein** · 06-22-2022, 12:43 PM

This is post https://excelfox.com/forum/showthrea...ll=1#post16643
https://excelfox.com/forum/showthread.php/2345-Appendix-Thread-(-Codes-for-other-Threads-HTML-Tables-etc-)?p=16643&viewfull=1#post16643
https://excelfox.com/forum/showthrea...ge54#post16643
https://excelfox.com/forum/showthread.php/2345-Appendix-Thread-(-Codes-for-other-Threads-HTML-Tables-etc-)/page54#post16643

Some more notes related to these posts
http://www.eileenslounge.com/viewtop...296482#p296482

Making it more flexible / dynamic, most for academic interest and aesthetic Pleasure

The code is flexible already in terms of the number of elements in each cell, ( but note The macro assumes the cells all have the same number of elements - like __ 1,2,3,4 __ t,y,u,m __ 5,6,7,8 __ a,b,c,d )
This post extends the flexibility to a dynamic number of cells used. ( While I was writing this, the OP asked for a mod to increase the used cells from 2 to 4, so a flexible solution is , as often, worthwhile )

We almost certainly need to know how many cells we have, and the usual way is done to get that,
__ Lc = Ws1.Cells(2, Ws1.Columns.Count).End(xlToLeft).Column

Join an array of the cells
The key to the new flexible solution is to Join the elements of an array with a comma, where the elements are the cell values, which themselves are separated already with a comma. (So then as previously, we then finally have a single string of comma separated values, which we , as previously split by a comma, to give us our single array of all data values.
Initially we can get an array of cell values from applying the .Value property to our multi cell range.
Something of this sort of form, for example, for if we had 4 cells in the second row,
_________arrCels2D1Row() = Ws1.Range("A2:D2").Value2
A small snag here is that the array returned by the .Value property, is a 1 row, 2 Dimensional array, ( a pseudo “horizontal” , “single width” array) but the VBA strings Join function only accepts a 1 dimensional array. However, it’s a strange characteristic of VBA that many things if they are asked to return something in the orientation of pseudo “horizontal” , “single width” , then they return a 1 Dimensional array: It seems that somehow the internal workings often relate a row orientation to a single dimensional array. ( This is convenient to think about, as is the idea of pseudo “horizontal” , “single width” , since in the case of a 1 dimensional array we often write it in a line like {1, 2, 3, 6, "z"} , but we should remember that strictly speaking academically orientation in arrays is subjective. )
As example this seemingly redundant code line takes the first row from our single row 2 Dimensional array: Seemingly useless, but in fact it returns the 1 Dimensional array of cell values, as we require, -
___ arrCels1D() = Application.Index(arrCels2D1Row(), 1, 0)
___ ___ - Effectively that converts a 2 Dimensional 1 row array into a 1 Dimensional array, and why VBA has that sort of strange characteristic thing is not clearly known

After this, we simply modify the previous solutions to replace some hard coded values with the dynamic Lc: For example we see the number 2 used frequently, when we originally had 2 cells, and this will likely need to be replaced by Lc, and correspondingly we used B in places where this will likely need to be replaced by the column letter corresponding to column Lc

Unfortunately, the final single code line does not quite fit on one line, but it is one code line, but needs to be split to get it in the VB Editor

Code:

Sub PrettydammBeautiful()
 Range("A2").Resize((UBound(Split(Join(Application.Index(Range("A2:" & Split(Cells(1, Cells(2, Columns.Count).End(xlToLeft).Column).Address, "$")(1) & "2").Value2, 1, 0), ","), ",")) + 1) / Cells(2, Columns.Count).End(xlToLeft).Column, Cells(2, Columns.Count).End(xlToLeft).Column).Value = _
 Application.Index(Split(Join(Application.Index(Range("A2:" & Split(Cells(1, Cells(2, Columns.Count).End(xlToLeft).Column).Address, "$")(1) & "2").Value2, 1, 0), ","), ","), 1, Evaluate("=Row(1:" & (UBound(Split(Join(Application.Index(Range("A2:" & Split(Cells(1, Cells(2, Columns.Count).End(xlToLeft).Column).Address, "$")(1) & "2").Value2, 1, 0), ","), ",")) + 1) / Cells(2, Columns.Count).End(xlToLeft).Column & ")+((Column(A:" & Split(Cells(1, Cells(2, Columns.Count).End(xlToLeft).Column).Address, "$")(1) & ")-1)*" & (UBound(Split(Join(Application.Index(Range("A2:" & Split(Cells(1, Cells(2, Columns.Count).End(xlToLeft).Column).Address, "$")(1) & "2").Value2, 1, 0), ","), ",")) + 1) / Cells(2, Columns.Count).End(xlToLeft).Column & ")"))

End Sub

Here the full story: see next post

**DocAElstein** · 06-24-2022, 03:56 PM

Here is the full workings for the last macro from the last post

Code:

Sub SplitDataFlexibly() '
Rem 1 worksheets data info
Dim Ws1 As Worksheet: Set Ws1 = ThisWorkbook.Worksheets.Item("Sheet1")
Dim Lc As Long: Let Lc = Ws1.Cells(2, Ws1.Columns.Count).End(xlToLeft).Column: Lc = Cells(2, Columns.Count).End(xlToLeft).Column
Rem 2 create a 1 Dimensional array of all data
Dim LCL As String: Let LCL = Split(Cells(1, Lc).Address, "$", 3, vbBinaryCompare)(1): LCL = Split(Cells(1, Lc).Address, "$")(1) ' what we are doing is splitting like  $D$1  by the  $  and then taking the second element,  in the example that will be  D
Dim arrCels2D1Row() As Variant: Let arrCels2D1Row() = Ws1.Range("A2:" & LCL & "2").Value2
Dim arrCels1D() As Variant: Let arrCels1D() = Application.Index(arrCels2D1Row(), 1, 0)
Dim strDta As String: Let strDta = Join(arrCels1D(), ",")                                        'Ws2.Range("A2").Value & "," & Ws2.Range("B2").Value
Rem 3 Making previous solution dynamic, - requires changing  B  with  " & LCL & "   and some hard coded occurasnces  of  2  with   Lc
Dim arrIn() As String
 Let arrIn() = Split(strDta, ",", -1, vbBinaryCompare)
' Or
 arrIn() = Split(Join(arrCels1D(), ","), ",")
Dim Clms() As Variant
 ' the next lines, used in previous example. is for the case of two cells, so we need to change some hard coded stuff to make the solution dynamic. ' Let Clms() = Evaluate("=Row(1:4)+((Column(A:B)-1)*" & (UBound(arrIn()) + 1) / 2 & ")")
 ' Let Clms() = Evaluate("=Row(1:" & (UBound(arrIn()) + 1) / 2 & ")+((Column(A:B)-1)*" & (UBound(arrIn()) + 1) / 2 & ")")
  Let Clms() = Evaluate("=Row(1:" & (UBound(arrIn()) + 1) / Lc & ")+((Column(A:" & LCL & ")-1)*" & (UBound(arrIn()) + 1) / Lc & ")")
Dim arrOut() As Variant
 Let arrOut() = Application.Index(arrIn(), 1, Clms())
' Let Ws2.Range("A2").Resize((UBound(arrIn()) + 1) / 2, 2).Value = arrOut() ' This was the case for 2 cells
 Let Ws1.Range("A2").Resize((UBound(arrIn()) + 1) / Lc, Lc).Value = arrOut()
' Or
' Range("A2").Resize((UBound(arrIn()) + 1) / Lc, Lc).Value = arrOut()
' Range("A2").Resize((UBound(arrIn()) + 1) / Lc, Lc).Value = Application.Index(arrIn(), 1, Clms())
' Range("A2").Resize((UBound(arrIn()) + 1) / Lc, Lc).Value = Application.Index(arrIn(), 1, Evaluate("=Row(1:" & (UBound(arrIn()) + 1) / Lc & ")+((Column(A:" & LCL & ")-1)*" & (UBound(arrIn()) + 1) / Lc & ")"))
' Range("A2").Resize((UBound(Split(Join(arrCels1D(), ","), ",")) + 1) / Lc, Lc).Value = Application.Index(Split(Join(arrCels1D(), ","), ","), 1, Evaluate("=Row(1:" & (UBound(arrIn()) + 1) / Lc & ")+((Column(A:" & LCL & ")-1)*" & (UBound(arrIn()) + 1) / Lc & ")"))
' Range("A2").Resize((UBound(Split(Join(arrCels1D(), ","), ",")) + 1) / Lc, Lc).Value = Application.Index(Split(Join(arrCels1D(), ","), ","), 1, Evaluate("=Row(1:" & (UBound(Split(Join(arrCels1D(), ","), ",")) + 1) / Lc & ")+((Column(A:" & LCL & ")-1)*" & (UBound(Split(Join(arrCels1D(), ","), ",")) + 1) / Lc & ")"))
' Range("A2").Resize((UBound(Split(Join(Application.Index(arrCels2D1Row(), 1, 0), ","), ",")) + 1) / Lc, Lc).Value = Application.Index(Split(Join(Application.Index(arrCels2D1Row(), 1, 0), ","), ","), 1, Evaluate("=Row(1:" & (UBound(Split(Join(Application.Index(arrCels2D1Row(), 1, 0), ","), ",")) + 1) / Lc & ")+((Column(A:" & LCL & ")-1)*" & (UBound(Split(Join(Application.Index(arrCels2D1Row(), 1, 0), ","), ",")) + 1) / Lc & ")"))
' Range("A2").Resize((UBound(Split(Join(Application.Index(Ws1.Range("A2:" & LCL & "2").Value2, 1, 0), ","), ",")) + 1) / Lc, Lc).Value = Application.Index(Split(Join(Application.Index(Ws1.Range("A2:" & LCL & "2").Value2, 1, 0), ","), ","), 1, Evaluate("=Row(1:" & (UBound(Split(Join(Application.Index(Ws1.Range("A2:" & LCL & "2").Value2, 1, 0), ","), ",")) + 1) / Lc & ")+((Column(A:" & LCL & ")-1)*" & (UBound(Split(Join(Application.Index(arrCels2D1Row(), 1, 0), ","), ",")) + 1) / Lc & ")"))
' Range("A2").Resize((UBound(Split(Join(Application.Index(Ws1.Range("A2:" & Split(Cells(1, Lc).Address, "$")(1) & "2").Value2, 1, 0), ","), ",")) + 1) / Lc, Lc).Value = Application.Index(Split(Join(Application.Index(Ws1.Range("A2:" & Split(Cells(1, Lc).Address, "$")(1) & "2").Value2, 1, 0), ","), ","), 1, Evaluate("=Row(1:" & (UBound(Split(Join(Application.Index(Ws1.Range("A2:" & LCL & "2").Value2, 1, 0), ","), ",")) + 1) / Lc & ")+((Column(A:" & Split(Cells(1, Lc).Address, "$")(1) & ")-1)*" & (UBound(Split(Join(Application.Index(arrCels2D1Row(), 1, 0), ","), ",")) + 1) / Lc & ")"))
' Range("A2").Resize((UBound(Split(Join(Application.Index(Range("A2:" & Split(Cells(1, Lc).Address, "$")(1) & "2").Value2, 1, 0), ","), ",")) + 1) / Lc, Lc).Value = Application.Index(Split(Join(Application.Index(Range("A2:" & Split(Cells(1, Lc).Address, "$")(1) & "2").Value2, 1, 0), ","), ","), 1, Evaluate("=Row(1:" & (UBound(Split(Join(Application.Index(Range("A2:" & LCL & "2").Value2, 1, 0), ","), ",")) + 1) / Lc & ")+((Column(A:" & Split(Cells(1, Lc).Address, "$")(1) & ")-1)*" & (UBound(Split(Join(Application.Index(arrCels2D1Row(), 1, 0), ","), ",")) + 1) / Lc & ")"))
' Range("A2").Resize((UBound(Split(Join(Application.Index(Range("A2:" & Split(Cells(1, Cells(2, Columns.Count).End(xlToLeft).Column).Address, "$")(1) & "2").Value2, 1, 0), ","), ",")) + 1) / Cells(2, Columns.Count).End(xlToLeft).Column, Cells(2, Columns.Count).End(xlToLeft).Column).Value = Application.Index(Split(Join(Application.Index(Range("A2:" & Split(Cells(1, Cells(2, Columns.Count).End(xlToLeft).Column).Address, "$")(1) & "2").Value2, 1, 0), ","), ","), 1, Evaluate("=Row(1:" & (UBound(Split(Join(Application.Index(Range("A2:" & LCL & "2").Value2, 1, 0), ","), ",")) + 1) / Cells(2, Columns.Count).End(xlToLeft).Column & ")+((Column(A:" & Split(Cells(1, Cells(2, Columns.Count).End(xlToLeft).Column).Address, "$")(1) & ")-1)*" & (UBound(Split(Join(Application.Index(arrCels2D1Row(), 1, 0), ","), ",")) + 1) / Cells(2, Columns.Count).End(xlToLeft).Column & ")"))
' Range("A2").Resize((UBound(Split(Join(Application.Index(Range("A2:" & Split(Cells(1, Cells(2, Columns.Count).End(xlToLeft).Column).Address, "$")(1) & "2").Value2, 1, 0), ","), ",")) + 1) / Cells(2, Columns.Count).End(xlToLeft).Column, Cells(2, Columns.Count).End(xlToLeft).Column).Value = Application.Index(Split(Join(Application.Index(Range("A2:" & Split(Cells(1, Cells(2, Columns.Count).End(xlToLeft).Column).Address, "$")(1) & "2").Value2, 1, 0), ","), ","), 1, Evaluate("=Row(1:" & (UBound(Split(Join(Application.Index(Range("A2:" & Split(Cells(1, Lc).Address, "$")(1) & "2").Value2, 1, 0), ","), ",")) + 1) / Cells(2, Columns.Count).End(xlToLeft).Column & ")+((Column(A:" & Split(Cells(1, Cells(2, Columns.Count).End(xlToLeft).Column).Address, "$")(1) & ")-1)*" & (UBound(Split(Join(Application.Index(arrCels2D1Row(), 1, 0), ","), ",")) + 1) / Cells(2, Columns.Count).End(xlToLeft).Column & ")"))
' Range("A2").Resize((UBound(Split(Join(Application.Index(Range("A2:" & Split(Cells(1, Cells(2, Columns.Count).End(xlToLeft).Column).Address, "$")(1) & "2").Value2, 1, 0), ","), ",")) + 1) / Cells(2, Columns.Count).End(xlToLeft).Column, Cells(2, Columns.Count).End(xlToLeft).Column).Value = Application.Index(Split(Join(Application.Index(Range("A2:" & Split(Cells(1, Cells(2, Columns.Count).End(xlToLeft).Column).Address, "$")(1) & "2").Value2, 1, 0), ","), ","), 1, Evaluate("=Row(1:" & (UBound(Split(Join(Application.Index(Range("A2:" & Split(Cells(1, Lc).Address, "$")(1) & "2").Value2, 1, 0), ","), ",")) + 1) / Cells(2, Columns.Count).End(xlToLeft).Column & ")+((Column(A:" & Split(Cells(1, Cells(2, Columns.Count).End(xlToLeft).Column).Address, "$")(1) & ")-1)*" & (UBound(Split(Join(Application.Index(Range("A2:" & LCL & "2").Value2, 1, 0), ","), ",")) + 1) / Cells(2, Columns.Count).End(xlToLeft).Column & ")"))
' Range("A2").Resize((UBound(Split(Join(Application.Index(Range("A2:" & Split(Cells(1, Cells(2, Columns.Count).End(xlToLeft).Column).Address, "$")(1) & "2").Value2, 1, 0), ","), ",")) + 1) / Cells(2, Columns.Count).End(xlToLeft).Column, Cells(2, Columns.Count).End(xlToLeft).Column).Value = Application.Index(Split(Join(Application.Index(Range("A2:" & Split(Cells(1, Cells(2, Columns.Count).End(xlToLeft).Column).Address, "$")(1) & "2").Value2, 1, 0), ","), ","), 1, Evaluate("=Row(1:" & (UBound(Split(Join(Application.Index(Range("A2:" & Split(Cells(1, Lc).Address, "$")(1) & "2").Value2, 1, 0), ","), ",")) + 1) / Cells(2, Columns.Count).End(xlToLeft).Column & ")+((Column(A:" & Split(Cells(1, Cells(2, Columns.Count).End(xlToLeft).Column).Address, "$")(1) & ")-1)*" & (UBound(Split(Join(Application.Index(Range("A2:" & Split(Cells(1, Lc).Address, "$")(1) & "2").Value2, 1, 0), ","), ",")) + 1) / Cells(2, Columns.Count).End(xlToLeft).Column & ")"))
 Range("A2").Resize((UBound(Split(Join(Application.Index(Range("A2:" & Split(Cells(1, Cells(2, Columns.Count).End(xlToLeft).Column).Address, "$")(1) & "2").Value2, 1, 0), ","), ",")) + 1) / Cells(2, Columns.Count).End(xlToLeft).Column, Cells(2, Columns.Count).End(xlToLeft).Column).Value = _
 Application.Index(Split(Join(Application.Index(Range("A2:" & Split(Cells(1, Cells(2, Columns.Count).End(xlToLeft).Column).Address, "$")(1) & "2").Value2, 1, 0), ","), ","), 1, Evaluate("=Row(1:" & (UBound(Split(Join(Application.Index(Range("A2:" & Split(Cells(1, Cells(2, Columns.Count).End(xlToLeft).Column).Address, "$")(1) & "2").Value2, 1, 0), ","), ",")) + 1) / Cells(2, Columns.Count).End(xlToLeft).Column & ")+((Column(A:" & Split(Cells(1, Cells(2, Columns.Count).End(xlToLeft).Column).Address, "$")(1) & ")-1)*" & (UBound(Split(Join(Application.Index(Range("A2:" & Split(Cells(1, Cells(2, Columns.Count).End(xlToLeft).Column).Address, "$")(1) & "2").Value2, 1, 0), ","), ",")) + 1) / Cells(2, Columns.Count).End(xlToLeft).Column & ")"))

End Sub

**DocAElstein** · 07-17-2022, 12:10 PM

In support of this main Forum post:
http://www.eileenslounge.com/viewtop...297074#p297074 http://http://www.eileenslounge.com/viewtop...297074#p297074
First overcomplicated Solution

Hello

Originally Posted by adeel1 post_id=297073 time=1657888942 user_id=7609

.... in real these values will go to another WBK.
:::
or now just one question, "public" will always declare for userfrom means storing value either within WBK or for Other WBK.

Originally Posted by HansV post_id=297076 time=1657891714 user_id=53

Public means that the variable will be "known" in all code modules of the same workbook, but not in code modules in other open workbooks. .

If Public variables are being the things that go in a normal code module, as I think they are, technically, or officially, or words to that effect, then that is the case that they won’t be known in other workbooks.
In other words, for the purposes of what is going on here, it means you will need to be storing them in the same workbook, as Hans said, and how he demonstrated.

However, you can do something that technically is not involving Public variables, but as far as I can tell, to all intents and purposes, is in effect the same thing as if you could have those Public variable in a different workbook.

The short story is:
Instead of putting the two public variables in a standard normal code module, ( in the same workbook) as Hans did, we can put them in any Class object code module in any open workbook. Technically they are not called Public variables. They are , I think, properties of the instantiated Class object, and we can access them, in the usual way that we access properties of an object.

The full story
PurseWayDoughPublicVariables.xls
I have another workbook uploaded, PurseWayDoughPublicVariables.xls . That is just to hold these variables. (I will call them “pseudo” Public variables, just because I feel like it

),
I can put them in any Class object code module, but just for fun, I will put C1 in a worksheet code module, and C2 in the ThisWorkbook code module.

So, this is what Hans did, public variables in a standard normal module like
Standard module, Module1

Code:

 Public C1 As String
Public C2 As String

Instead of doing that , I will put those variables in Class object code modules in PurseWayDoughPublicVariables.xls, like this:

Worksheet code module, Sheet1

Code:

 Public C1 As String
'
'
'
Sub PhilC1(ByVal Wrd As String)
 Let C1 = Wrd
End Sub

Workbook code module, ThisWorkbook

Code:

 Public C2 As String
'
'
'
Sub PhilC2(ByVal Wrd As String)
 Let C2 = Wrd
End Sub

*** The reason for those extra macros that fill the variables will be apparent shortly….
_.__________________________________-

Sample for Eli.xlsm
I need to modify now the workbook uploaded by Hans, in 3 main ways:
_(i) I don’t need the two public variables in a standard normal code module anymore
_(ii) I need to modify slightly how I reference the variables

Code:

 Sub Fi_l()
    'Act_ive
 'Let Range("A2").Resize(10).Value = C1
 Let Range("A2").Resize(10).Value = Workbooks("PurseWayDoughPublicVariables.xls").Worksheets("Sheet1").C1
 'let Range("B2").Resize(10).Value = C2
 Let Range("B2").Resize(10).Value = Workbooks("PurseWayDoughPublicVariables.xls").C2
End Sub

_(iii) Filling the variable is slightly more tricky. As far as I know, I can’t easily directly fill them from a macro in Sample for Eli.xlsm. - ***Edit: not true - see next post!! But I can run those extra macros*** that fill the variables, from Sample for Eli.xlsm
So to do that I modify the coding in the UserForm thus, ( for the purposes of this demo, I assume the two workbooks are stored in the same place):

Code:

 Private Sub CommandButton1_Click()
    Select Case Me.CheckBox1
     Case True
      'C1 = "yes"
      Application.Run Macro:="'" & ThisWorkbook.Path & "\" & "PurseWayDoughPublicVariables.xls'!Sheet1.PhilC1", Arg1:="Yus"
    End Select
    Select Case Me.CheckBox2
     Case True
      'C2 = "yes"
      Application.Run Macro:="'" & ThisWorkbook.Path & "\" & "PurseWayDoughPublicVariables.xls'!ThisWorkbook.PhilC2", Arg1:="Ja"
    End Select
 Unload Me
 Call Sheet2.Fi_l
End Sub

_.____

That’s it. So download both files, store them in the same place, and then the coding in Sample for Eli.xlsm should work as before. The only difference is that you are using the “pseudo” public variables in the workbook PurseWayDoughPublicVariables.xls

_.________________________________________________ _____________________

I have not seen this use of “pseudo” public variables much before, so there may be some reason I don’t know about why they should not be used??
But I use them myself sometimes, and so far I have never seen them behave any differently to “proper” public variables

( I would just finally say that I don’t use public variables much myself, pseudo or otherwise, if I can find another way to do what I want. I don’t like public variables myself. For one reason: I find they have an annoying habit of getting emptied sometimes. )

Alan

Ref
https://stackoverflow.com/questions/...ther-workbook#
https://excelfox.com/forum/showthrea...ll=1#post11870
https://stackoverflow.com/questions/...12342#59812342
https://www.mrexcel.com/board/thread.../#post-4629654

**DocAElstein** · 07-17-2022, 12:58 PM

In support of this main Forum post:
http://www.eileenslounge.com/viewtop...297074#p297074 http://http://www.eileenslounge.com/viewtop...297074#p297074
Second simplified Solution

I think in the first solution I made initially a mistake in trying to set the pseudo public variables, *** and so went off in a tangent using the Application.Run stuff. You don’t need any of that and can forget the two macros that fill the variables as well.

You just need this

Worksheet code module, Sheet1 ( in PurseWayDoughPublicVariables.xls )

Code:

 Public C1 As String

Workbook code module, ThisWorkbook ( in PurseWayDoughPublicVariables.xls )

Code:

 Public C2 As String

And then the other macros are like

Code:

Private Sub CommandButton1_Click()
    Select Case Me.CheckBox1
     Case True
      'C1 = "yes"
                                          '  Application.Run Macro:="'" & ThisWorkbook.Path & "\" & "PurseWayDoughPublicVariables.xls'!Sheet1.PhilC1", Arg1:="Yus"
     Let Workbooks("PurseWayDoughPublicVariables.xls").Worksheets("Sheet1").C1 = "Yus"
    End Select
    Select Case Me.CheckBox2
     Case True
      'C2 = "yes"
                                          '  Application.Run Macro:="'" & ThisWorkbook.Path & "\" & "PurseWayDoughPublicVariables.xls'!ThisWorkbook.PhilC2", Arg1:="Ja"
     Let Workbooks("PurseWayDoughPublicVariables.xls").C2 = "Ja"
    End Select
 Unload Me
 Call Sheet2.Fi_l
End Sub

Code:

Sub Fi_l()
    'Act_ive
 'Let Range("A2").Resize(10).Value = C1
 Let Range("A2").Resize(10).Value = Workbooks("PurseWayDoughPublicVariables.xls").Worksheets("Sheet1").C1
 'let Range("B2").Resize(10).Value = C2
 Let Range("B2").Resize(10).Value = Workbooks("PurseWayDoughPublicVariables.xls").C2
End Sub

**DocAElstein** · 07-22-2022, 12:03 PM

Some extra notes for this Thread:
http://www.eileenslounge.com/viewtopic.php?f=30&t=38460

Hans Solution http://www.eileenslounge.com/viewtop...297266#p297266
This is a nice solution which I totally misread, or rather in my ignorance, I did not understand.

The main point I missed is…
The solution assumes that the final solution actually has a 26 element 1 dimensional array, and the weight numbers in that array are sorted in alphabetical order, so that the first element represents the weight for “A” and the last Element represents the weight for “Z”, etc.
( So the array Letters() is redundant, and only the Weights() array is needed )
Hans has kindly set me straight and explained where I was going wrong. The final working version of his solution is

Code:

Sub Testit()
 MsgBox prompt:=Weight("ZAC")
End Sub
' https://eileenslounge.com/viewtopic.php?f=30&t=38460&sid=4295ec4560088f42492ca29590271a87
Public Function Weight(S As String) As Long ' http://www.eileenslounge.com/viewtopic.php?p=297266#p297266
Dim Weights() As Variant  ' Letters() As Variant,
Dim i As Long
'    Letters = Array("A", "B", "C", ..., "Z")
'    Weights = Array(1, 5, 3, ..., 2)
 '                     A, B, C, D, E, F, G, H, I, J, K, L, M, N, O, P, Q, R, S, T, U, V, W, X, Y, Z
 Let Weights() = Array(1, 5, 3, 1, 4, 3, 2, 1, 6, 4, 5, 3, 2, 1, 2, 3, 4, 5, 6, 7, 6, 5, 4, 3, 2, 2) ' Watch : - : Weights() :  : Variant/Variant(0 to 25) : Module1.Weight
    For i = 1 To Len(S)
     Let Weight = Weight + Weights(Asc(Mid(S, i, 1)) - 65)
    Next i
End Function

How is that working:
We are looping through each character, then doing something clever to get the running total. The clever bit is getting the array element
To demonstrate that working consider a couple of examples for the case of a word having an A and a Z in it
A has the Ascii Code number of 65. So we end up referring to Weights(65-65) = Weights(0) , which is the first element typically in a 1 dimensional array that starts at indicia 0
Z has the Ascii Code number of 90. So we end up referring to Weights(90-65) = Weights(25) , which is the last element in a 1 dimensional array of 26 elements that starts at indicia 0

In order for the function to get correct results in the case of lower case letters, then one way to do it, ( assuming you have the correct Weights() array you want for lower case letters), you would need to change the 65 to 97

Code:

Sub Testit()
Debug.Print Tab(4); "ASCII"; Tab(12); "Weight"
Debug.Print Tab(4); "Code"
 Call Weight("ZAC")
Debug.Print
 Call WeightLowerCase("zac")
End Sub
' https://eileenslounge.com/viewtopic.php?f=30&t=38460&sid=4295ec4560088f42492ca29590271a87
Public Function Weight(S As String) As Long ' http://www.eileenslounge.com/viewtopic.php?p=297266#p297266
Dim Weights() As Variant  ' Letters() As Variant,
Dim i As Long
 '                     A, B, C, D, E, F, G, H, I, J, K, L, M, N, O, P, Q, R, S, T, U, V, W, X, Y, Z
 Let Weights() = Array(1, 5, 3, 1, 4, 3, 2, 1, 6, 4, 5, 3, 2, 1, 2, 3, 4, 5, 6, 7, 6, 5, 4, 3, 2, 2) ' Watch : - : Weights() :  : Variant/Variant(0 to 25) : Module1.Weight
    For i = 1 To Len(S)
     Let Weight = Weight + Weights(Asc(Mid(S, i, 1)) - 65)
     Debug.Print Mid(S, i, 1); Tab(4); Asc(Mid(S, i, 1)); Tab(8); Asc(Mid(S, i, 1)) - 65; Tab(12); Weights(Asc(Mid(S, i, 1)) - 65)
    Next i
End Function
Public Function WeightLowerCase(S As String) As Long ' http://www.eileenslounge.com/viewtopic.php?p=297266#p297266
Dim Weights() As Variant  ' Letters() As Variant,
Dim i As Long
 '                     a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t, u, v, w, x, y, z
 Let Weights() = Array(1, 5, 3, 1, 4, 3, 2, 1, 6, 4, 5, 3, 2, 1, 2, 3, 4, 5, 6, 7, 6, 5, 4, 3, 2, 2) '
    For i = 1 To Len(S)
     Let WeightLowerCase = WeightLowerCase + Weights(Asc(Mid(S, i, 1)) - 97)
     Debug.Print Mid(S, i, 1) & vbTab & Asc(Mid(S, i, 1)) & vbTab & Asc(Mid(S, i, 1)) - 97 & vbTab & Weights(Asc(Mid(S, i, 1)) - 97)
    Next i
End Function

Here is the Debug.Print output from the last demo coding

Code:

   ASCII   Weight
   Code
Z   90  25  2 
A   65  0   1 
C   67  2   3 

z   122 25  2
a   97  0   1
c   99  2   3

Thread: Appendix Thread. 3 TEST COPY

Thread Tools

Search Thread

Display

Similar Threads

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

Appendix Thread. App Index Rws() Clms() Majic code line Codings for other Threads, Tables etc) TEST COPY

Appendix Thread. 3 *

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

Appendix Thread. Diet Protokol Coding Adaptions

Bookmarks

Bookmarks

Posting Permissions