Tests Copying, Pasting, API Cliipboard issues. and Rough notes on Advanced API stuff

**DocAElstein** · 02-26-2023, 06:55 PM

….Continued from last post ( https://excelfox.com/forum/showthrea...ll=1#post19820
https://excelfox.com/forum/showthrea...ge52#post19820 )

The dictionary type way, like already done there by Hans ( https://eileenslounge.com/viewtopic....e527ed#p304935 ). is quite common and a good way. Often it’s the best , most efficient way.

Just for comparison to further the subject and discussion a bit , here’s another way.
To main differences, or rather two main things being done which are uncommon , or at least less common, as yet,

_1) Do While Loops
we use two Do While Loop things, one nested in the other.
The inner loop goes through each row in each of the ( in this example data ) 4 sections, and the outer Loop just takes us on to the next section. So effectively we loop through each data row. Potentially this my reduce the number of loops compared to other ways
The main thing that goes on is that a single string is built up, and that string contains most of the output data. This is arranged in a format such that the data column separator is the vbTab, and the row / line separator is the typical vbCr & vbLf pair
_2) Use of Clipboard
The string built up is put in the Clipboard. The Clipboard recognises the format as that of a Excel range, so we can paste that out.

Code:

Sub Transformator()
Rem 0 worksheets and data info
Dim Wss As Worksheet, Wst As Worksheet
 Set Wss = ThisWorkbook.Worksheets.Item(1): Set Wst = ThisWorkbook.Worksheets.Item(3)
Dim CuRe As Range
 Set CuRe = Wss.Range("A1").CurrentRegion
 Set CuRe = CuRe.Resize(CuRe.Rows.Count + 1) ' An extra empty row is often useful to make a  Do While Loop thing  of this sort teminate and not error when looking at the next after last
Dim Ars() As Variant
 Let Ars() = CuRe.Value
Rem 1 This is a  Do While Loop  nested in another  Do While Loop   In effect it loops through each data row and bulids up a final string in a form the clipboard will recognise as the final output data Excel range
Dim RCnt As Long: Let RCnt = 2
Dim strClp As String: Let strClp = "ReptClms"  ' The final string of data output to go in the clipboard to be pasted out.  I add a place with  ReptClms  whgich i replace later with the repeated columns
    Do While RCnt < UBound(Ars(), 1) ' Outer Loop - Loops once for each section
        Do '  While Ars(RCnt - 1, 1) = Ars(RCnt, 1) ' Inner Loop - loops in each section for as many rows in each section
         Let strClp = strClp & vbTab & Ars(RCnt, 6) ' This is buildiung the   Yes NA Maybe Real   string bit for each section
         Let RCnt = RCnt + 1 ' Move a row down in each section or effectiuvely to next section if condition below not met
        Loop While Ars(RCnt - 1, 1) = Ars(RCnt, 1)
        ' At this point we have the   Yes NA Maybe Real   (and also an extra  vbTab  at the start which we don't want), but  so need to add the other stuff for an output data row
      Let strClp = Replace(strClp, "ReptClms" & vbTab, Ars(RCnt - 1, 1) & vbTab & Ars(RCnt - 1, 2) & vbTab & Ars(RCnt - 1, 3) & vbTab & Ars(RCnt - 1, 4) & vbTab, 1, 1, vbBinaryCompare) ' Adding The first four columns of repeated values, and at the same time get rid of the unwanted  vbTab
      Let strClp = strClp & vbCr & vbLf ' This effectively ads a row in the form recognised by the Clipboard
      Let strClp = strClp & "ReptClms"
     ' Let RCnt = RCnt + 1 ' move a row down to the next section
    Loop ' While RCnt < UBound(Ars(), 1)
 Let strClp = Left(strClp, Len(strClp) - 10) ' This takes off the 11 characters of    vbCr vbLf R e p t C l m s
Rem 2 We have the main output , so stick it in the 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:=strClp
 objDataObject.PutInClipboard
Rem 3 Output main data output
 Wst.Paste Destination:=Wst.Range("A2")
Rem 4 the header stuff
'4a) copied headers
 Let Wst.Range("A1:D1").Value = Wss.Range("A1:D1").Value
'4b) The consequtive   S1  S2    etc stuf
Dim Ss() As Variant ' ' Example given data,  we need to get  S1 S2 .. S14
 Let Ss() = Evaluate("=" & """" & "S" & """" & "&" & "COLUMN(A:N)") ' This gets it
' So, Get the N from what we do know - knowing the column count number for example
Dim CL As String
 Let CL = Split(Cells(1, 18 - 4).Address, "$", 3, vbBinaryCompare)(1) ' = N   got from like second element, (1),  after spliting  $N$14  by the  $   ($N$14 is the address of  cell 1, 14        (0) is ""  (1) is N   (2) is 14      )
 Let CL = Split(Cells(1, 18 - 4).Address, "$")(1)
' 18 is the output data final column count
Dim rngOut As Range: Set rngOut = Wst.Range("A1").CurrentRegion
  Let CL = Split(Cells(1, rngOut.Columns.Count - 4).Address, "$", 3, vbBinaryCompare)(1) ' = N   got from like second element, (1),  after spliting  $N$14  by the  $   ($N$14 is the address of  cell 1, 14        (0) is ""  (1) is N   (2) is 14      )
  Let CL = Split(Cells(1, rngOut.Columns.Count - 4).Address, "$")(1) '
 ' Or
 Let Ss() = Evaluate("=" & """" & "S" & """" & "&" & "COLUMN(A:" & Split(Cells(1, rngOut.Columns.Count - 4).Address, "$")(1) & ")")
 Let Ss() = Evaluate("=" & """" & "S" & """" & "&" & "COLUMN(A:" & Split(Cells(1, Wst.Range("A1").CurrentRegion.Columns.Count - 4).Address, "$")(1) & ")")
 
 Let Ss() = Evaluate("=""S""" & "&" & "COLUMN(A:" & Split(Cells(1, Wst.Range("A1").CurrentRegion.Columns.Count - 4).Address, "$")(1) & ")")
 
 Let Wst.Range("E1").Resize(1, 14).Value = Evaluate("=""S""" & "&" & "COLUMN(A:" & Split(Cells(1, Wst.Range("A1").CurrentRegion.Columns.Count - 4).Address, "$")(1) & ")")
End Sub

**DocAElstein** · 06-18-2023, 01:25 PM

Some more notes in support of this main Forum Thread
https://www.eileenslounge.com/viewto...p?f=27&t=39784

Code:

Sub ClipIt() ' https://www.eileenslounge.com/viewtopic.php?f=27&t=39784
 Selection.Copy  '  Or   Application.SendKeys "^c"
    With GetObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")  '    http://web.archive.org/web/20200124185244/http://excelmatters.com/2013/10/04/late-bound-msforms-dataobject/
    Dim StringBack As String ' This is for the entire text held for the range in the windows clipboard after a  .Copy
     .GetFromClipboard: Let StringBack = .GetText()
     Let StringBack = Replace(StringBack, vbCr & vbLf, ", ", 1, -1, vbBinaryCompare) '  Binary - derived from the internal binary representations of the characters    https://www.eileenslounge.com/viewtopic.php?p=308065#p308065
     Let StringBack = Left(StringBack, Len(StringBack) - 2) '  .Copy  adds an extra trailing vbCr & vbLf      https://www.eileenslounge.com/viewtopic.php?p=303007#p303007    
     .Clear
     .SetText StringBack
     .PutInClipboard
    End With
 Let Selection(1).Offset(1, 1).NumberFormat = "@"
 ActiveSheet.Paste Destination:=Selection(1).Offset(1, 1)
End Sub