Link to home
Start Free TrialLog in
Avatar of sq30
sq30

asked on

VBA to copy worksheet range to web based text box padded to mimic worksheet view

Hello,

Attached is a test workbook where I need to copy range A1:J22 from an excel worksheet to a web based applications text box. When doing so the output is not padded and pastes as in the attached file Test1-current.txt. I would like to output to paste as per file Test1-required.txt. The majority of the cells input value lenghts wil be variable.

Please help - thank you.
Sq30
Test1.xlsm
Test1-current.txt
Test1-required.txt
Avatar of aikimark
aikimark
Flag of United States of America image

there is no code in your workbook.
Avatar of sq30
sq30

ASKER

Exactly, as I have no clue how to achieve what I've asked. This is what I'd normally use but the result is not what I require.

Sub DataCopy()

Dim SheetCopy As Worksheet
Set SheetCopy = Worksheets("HelpPlease")

SheetCopy.Range("A1:J22").Copy

End Sub

Open in new window

What browser are you using for your tests and production?
What kind of control are you trying to paste the cell values into?
Avatar of sq30

ASKER

IE9 and a text box. Is this something your able to help with?
Not a text area control?  I need to be able to test any code I create.

Is this your web page or one created by someone else?

I should be able to help.  I'm trying to get a handle on the exact nature of the problem you face, which is why I'm asking you questions.
Also, it might help to know if the Excel data will be in the same format as you've shown or if it is likely to change.
This is going to get us close.  

The deficit with this code is that it does not properly account for text that runs past its cell.  That is why row 7 contents wrap around to line 8 in the output.
Sub Q_28474773()
    Dim vMatrix As Variant
    Dim strOutput() As String
    Dim lngRow As Long, lngCol As Long, lngMergedCol As Long
    Dim oDO As Object
    Set oDO = CreateObject("new:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")

    vMatrix = ActiveSheet.Range("a1", "j22").Value
'    Debug.Print LBound(vMatrix, 1), UBound(vMatrix, 1)
'    Debug.Print LBound(vMatrix, 2), UBound(vMatrix, 2)
    ReDim strOutput(1 To UBound(vMatrix, 1))
    For lngRow = 1 To UBound(vMatrix, 1)
        For lngCol = 1 To UBound(vMatrix, 2)
            If ActiveSheet.Cells(lngRow, lngCol).MergeArea.Columns.Count = 1 Then
                If Len(vMatrix(lngRow, lngCol)) <= 14 Then
                    strOutput(lngRow) = strOutput(lngRow) & Left(vMatrix(lngRow, lngCol) & Space(14), 14)
                Else
                    strOutput(lngRow) = strOutput(lngRow) & vMatrix(lngRow, lngCol) & Space(Len(vMatrix(lngRow, lngCol)) Mod 14)
                End If
            Else
                If Len(vMatrix(lngRow, lngCol)) <= 14 Then
                    For lngMergedCol = 1 To ActiveSheet.Cells(lngRow, lngCol).MergeArea.Columns.Count
                        strOutput(lngRow) = strOutput(lngRow) & Space(14)
                    Next
                Else
                    strOutput(lngRow) = strOutput(lngRow) & vMatrix(lngRow, lngCol) & Space(Len(vMatrix(lngRow, lngCol)) Mod 14)
                End If
            End If
        Next
        strOutput(lngRow) = RTrim(strOutput(lngRow))
        'Debug.Print strOutput(lngRow)
    Next
    oDO.Clear
    oDO.SetText Join(strOutput, vbCrLf)
    oDO.PutInClipboard
End Sub

Open in new window

Avatar of sq30

ASKER

Its not a page I've created so I can't tell you further than that. The format of the text will be the same but the length in the cells variable. If i was going to do this on the worksheet I'd get the length of each cell and the maximum value in the column and then perhaps vlookup for cells with that have values of 1,2 ,3 spaces etc and concatenate that. I was hoping that there is an easier method.  Thinking about this futher I need to let you know how long each line is in the text box to preven wrapping.  I can't  do this at the moment.
Avatar of sq30

ASKER

Sorry posts crossed. I'll test asap - thank you.
This is very close.
Sub Q_28474773()
    Dim vMatrix As Variant
    Dim strOutput() As String
    Dim lngRow As Long, lngCol As Long, lngMergedCol As Long, lngSkip As Long
    Dim oDO As Object
    Set oDO = CreateObject("new:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")

    vMatrix = ActiveSheet.Range("a1", "j22").Value
'    Debug.Print LBound(vMatrix, 1), UBound(vMatrix, 1)
'    Debug.Print LBound(vMatrix, 2), UBound(vMatrix, 2)
    ReDim strOutput(1 To UBound(vMatrix, 1))
    For lngRow = 1 To UBound(vMatrix, 1)
        For lngCol = 1 To UBound(vMatrix, 2)
            If lngSkip > 0 Then
                lngSkip = lngSkip - 1
            Else
                If ActiveSheet.Cells(lngRow, lngCol).MergeArea.Columns.Count = 1 Then
                    If Len(vMatrix(lngRow, lngCol)) <= 14 Then
                        strOutput(lngRow) = strOutput(lngRow) & Left(RTrim(vMatrix(lngRow, lngCol)) & Space(14), 14)
                    Else
                        strOutput(lngRow) = strOutput(lngRow) & RTrim(vMatrix(lngRow, lngCol)) & Space(Len(RTrim(vMatrix(lngRow, lngCol))) Mod 14)
                        lngSkip = (Len(RTrim(vMatrix(lngRow, lngCol))) \ 14) + 2
                    End If
                Else
                    If Len(vMatrix(lngRow, lngCol)) <= 14 Then
                        For lngMergedCol = 1 To ActiveSheet.Cells(lngRow, lngCol).MergeArea.Columns.Count
                            strOutput(lngRow) = strOutput(lngRow) & Space(14)
                        Next
                    Else
                        strOutput(lngRow) = strOutput(lngRow) & vMatrix(lngRow, lngCol) & Space(Len(vMatrix(lngRow, lngCol)) Mod 14)
                    End If
                End If
            End If
        Next
        strOutput(lngRow) = RTrim(strOutput(lngRow))
        'Debug.Print strOutput(lngRow)
    Next
    oDO.Clear
    oDO.SetText Join(strOutput, vbCrLf)
    oDO.PutInClipboard
End Sub

Open in new window


I'm testing the results in a textarea.  Here is my sample/test HTML
<!DOCTYPE html>
<html>
<head>
<style>
textarea { font-size: 18px; font-family: courier;}
</style>
</head>
<body>
<pre>
<textarea name="BasicTextArea" rows="25" cols="120"></textarea>
</pre>
</body>
</html>

Open in new window

Avatar of sq30

ASKER

You're getting very close - thank you.

The text box is 110 characters wide. The cells formated as numbers are not displaying correctly and showing as  e.g  2250.438 for 2250.44 and 151 for 151.00

The second code is truncating some of the values.
Test1-2.xlsm
most everything is lining up.  I'm trying to figure out what is happening on rows [4,20..22].  On these rows, there appears to be some single character shift of text, either left or right.
Sub Q_28474773()
    Dim vMatrix As Variant
    Dim strOutput() As String
    Dim lngRow As Long, lngCol As Long, lngMergedCol As Long, lngSkip As Long
    Dim rng As Range
    Dim oDO As Object
    Set oDO = CreateObject("new:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
    
    Set rng = ActiveSheet.Range("a1", "j22")
    ReDim vMatrix(1 To rng.Rows.Count, 1 To rng.Columns.Count)
    For lngRow = 1 To rng.Rows.Count
        For lngCol = 1 To rng.Columns.Count
            vMatrix(lngRow, lngCol) = Trim(ActiveSheet.Cells(lngRow, lngCol).Text)
        Next
    Next
    
    ReDim strOutput(1 To UBound(vMatrix, 1))
    For lngRow = 1 To UBound(vMatrix, 1)
        For lngCol = 1 To UBound(vMatrix, 2)
            If lngSkip > 0 Then
                lngSkip = lngSkip - 1
            Else
                If ActiveSheet.Cells(lngRow, lngCol).MergeArea.Columns.Count = 1 Then
                    If Len(vMatrix(lngRow, lngCol)) <= 14 Then
'                        strOutput(lngRow) = strOutput(lngRow) & Left(Trim(ActiveSheet.Cells(lngRow, lngCol).Text) & Space(14), 14)
                        Select Case ActiveSheet.Cells(lngRow, lngCol).HorizontalAlignment
                            Case xlHAlignGeneral
                                Select Case ActiveSheet.Cells(lngRow, lngCol).NumberFormat
                                    Case "General"
                                        If IsNumeric(ActiveSheet.Cells(lngRow, lngCol).Value) Then
                                            strOutput(lngRow) = strOutput(lngRow) & Right(Space(14) & vMatrix(lngRow, lngCol), 14)
                                        Else
                                            strOutput(lngRow) = strOutput(lngRow) & Left(vMatrix(lngRow, lngCol) & Space(14), 14)
                                        End If
                                    Case "@"
                                        strOutput(lngRow) = strOutput(lngRow) & Left(vMatrix(lngRow, lngCol) & Space(14), 14)
                                    Case Else
                                        strOutput(lngRow) = strOutput(lngRow) & Right(Space(14) & vMatrix(lngRow, lngCol), 14)
                                End Select
                            Case xlHAlignLeft
                                strOutput(lngRow) = strOutput(lngRow) & Left(vMatrix(lngRow, lngCol) & Space(14), 14)
                            Case xlHAlignRight
                                strOutput(lngRow) = strOutput(lngRow) & Right(Space(14) & vMatrix(lngRow, lngCol), 14)
                            Case xlHAlignCenter
                                If Len(vMatrix(lngRow, lngCol)) Mod 2 = 0 Then
                                    strOutput(lngRow) = strOutput(lngRow) & Space((14 - Len(vMatrix(lngRow, lngCol))) / 2) & vMatrix(lngRow, lngCol) & Space((14 - Len(vMatrix(lngRow, lngCol))) / 2)
                                Else
                                    strOutput(lngRow) = strOutput(lngRow) & Space((14 - Len(vMatrix(lngRow, lngCol))) / 2) & vMatrix(lngRow, lngCol) & Space(((14 - Len(vMatrix(lngRow, lngCol))) / 2) - 1)
                                End If
                        End Select
                    Else
                        strOutput(lngRow) = strOutput(lngRow) & RTrim(vMatrix(lngRow, lngCol)) & Space(Len(RTrim(vMatrix(lngRow, lngCol))) Mod 14)
                        lngSkip = (Len(RTrim(vMatrix(lngRow, lngCol))) \ 14) + 2
                    End If
                Else
                    If Len(vMatrix(lngRow, lngCol)) <= 14 Then
                        For lngMergedCol = 1 To ActiveSheet.Cells(lngRow, lngCol).MergeArea.Columns.Count
                            strOutput(lngRow) = strOutput(lngRow) & Space(14)
                        Next
                    Else
                        strOutput(lngRow) = strOutput(lngRow) & vMatrix(lngRow, lngCol) & Space(Len(vMatrix(lngRow, lngCol)) Mod 14)
                    End If
                End If
            End If
        Next
        strOutput(lngRow) = RTrim(strOutput(lngRow))
        'Debug.Print strOutput(lngRow)
    Next
    oDO.Clear
    oDO.SetText Join(strOutput, vbCrLf)
    oDO.PutInClipboard
End Sub

Open in new window

I wasn't handling the centered text properly.  Arithmetic fixed.  Looks pretty.
Sub Q_28474773()
    Dim vMatrix As Variant
    Dim strOutput() As String
    Dim lngRow As Long, lngCol As Long, lngMergedCol As Long, lngSkip As Long
    Dim rng As Range
    Dim oDO As Object
    Set oDO = CreateObject("new:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
    
    Set rng = ActiveSheet.Range("a1", "j22")
    ReDim vMatrix(1 To rng.Rows.Count, 1 To rng.Columns.Count)
    For lngRow = 1 To rng.Rows.Count
        For lngCol = 1 To rng.Columns.Count
            vMatrix(lngRow, lngCol) = Trim(ActiveSheet.Cells(lngRow, lngCol).Text)
        Next
    Next
    
    ReDim strOutput(1 To UBound(vMatrix, 1))
    For lngRow = 1 To UBound(vMatrix, 1)
        For lngCol = 1 To UBound(vMatrix, 2)
            If lngSkip > 0 Then
                lngSkip = lngSkip - 1
            Else
                If ActiveSheet.Cells(lngRow, lngCol).MergeArea.Columns.Count = 1 Then
                    If Len(vMatrix(lngRow, lngCol)) <= 14 Then
'                        strOutput(lngRow) = strOutput(lngRow) & Left(Trim(ActiveSheet.Cells(lngRow, lngCol).Text) & Space(14), 14)
                        Select Case ActiveSheet.Cells(lngRow, lngCol).HorizontalAlignment
                            Case xlHAlignGeneral
                                Select Case ActiveSheet.Cells(lngRow, lngCol).NumberFormat
                                    Case "General"
                                        If IsNumeric(ActiveSheet.Cells(lngRow, lngCol).Value) Then
                                            strOutput(lngRow) = strOutput(lngRow) & Right(Space(14) & vMatrix(lngRow, lngCol), 14)
                                        Else
                                            strOutput(lngRow) = strOutput(lngRow) & Left(vMatrix(lngRow, lngCol) & Space(14), 14)
                                        End If
                                    Case "@"
                                        strOutput(lngRow) = strOutput(lngRow) & Left(vMatrix(lngRow, lngCol) & Space(14), 14)
                                    Case Else
                                        strOutput(lngRow) = strOutput(lngRow) & Right(Space(14) & vMatrix(lngRow, lngCol), 14)
                                End Select
                            Case xlHAlignLeft
                                strOutput(lngRow) = strOutput(lngRow) & Left(vMatrix(lngRow, lngCol) & Space(14), 14)
                            Case xlHAlignRight
                                strOutput(lngRow) = strOutput(lngRow) & Right(Space(14) & vMatrix(lngRow, lngCol), 14)
                            Case xlHAlignCenter
                                If Len(vMatrix(lngRow, lngCol)) Mod 2 = 0 Then
                                    strOutput(lngRow) = strOutput(lngRow) & Space((14 - Len(vMatrix(lngRow, lngCol))) / 2) & vMatrix(lngRow, lngCol) & Space((14 - Len(vMatrix(lngRow, lngCol))) / 2)
                                Else
                                    strOutput(lngRow) = strOutput(lngRow) & Space((14 - Len(vMatrix(lngRow, lngCol)) + 1) / 2) & vMatrix(lngRow, lngCol) & Space(((14 - Len(vMatrix(lngRow, lngCol)) - 1) \ 2))
                                End If
                        End Select
                    Else
                        strOutput(lngRow) = strOutput(lngRow) & RTrim(vMatrix(lngRow, lngCol)) & Space(Len(RTrim(vMatrix(lngRow, lngCol))) Mod 14)
                        lngSkip = (Len(RTrim(vMatrix(lngRow, lngCol))) \ 14) + 2
                    End If
                Else
                    If Len(vMatrix(lngRow, lngCol)) <= 14 Then
                        For lngMergedCol = 1 To ActiveSheet.Cells(lngRow, lngCol).MergeArea.Columns.Count
                            strOutput(lngRow) = strOutput(lngRow) & Space(14)
                        Next
                    Else
                        strOutput(lngRow) = strOutput(lngRow) & vMatrix(lngRow, lngCol) & Space(Len(vMatrix(lngRow, lngCol)) Mod 14)
                    End If
                End If
            End If
        Next
        strOutput(lngRow) = RTrim(strOutput(lngRow))
        'Debug.Print strOutput(lngRow)
    Next
    oDO.Clear
    oDO.SetText Join(strOutput, vbCrLf)
    oDO.PutInClipboard
End Sub

Open in new window

Avatar of sq30

ASKER

Looking better but row 8 is missing data.
Test1-3.xlsm
I see that.  Puzzling.
I'm going to do a major overhaul of the code
Avatar of sq30

ASKER

Thank you.
Avatar of sq30

ASKER

Hows the code coming along?
I'm testing my changes.  Stepping through the code.
Avatar of sq30

ASKER

Hello aikimark - I'm dissapointed with EE that I don't have a workable solution by now as my question from my perspective is nearly five days old. I do understand that this is an unpaid side line for you experts however I need a workable answer. It's 2300 here in the UK and if your unable to give me a solution by the morning please let me know so that I can  request attention. Many thanks for what you've done thus far.
ASKER CERTIFIED SOLUTION
Avatar of aikimark
aikimark
Flag of United States of America image

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
Avatar of sq30

ASKER

Using your last code the text it's still miss-aligned in places which is to do with the type of input box being used my end as when I use this code with the html you supplied it works perfect.  Thank you.
when I use this code with the html you supplied it works
What is the difference between my test page and the page you are using?
Avatar of sq30

ASKER

Nothing noticable and the clipboard pastes fine. It's once I press save one the web page that something happens to the input which ends up as per the screen shot.
Change line 111 to this and retest.
oDO.SetText Replace(Join(strOutput, vbCrLf), " ", "&nbsp;")

Open in new window

Avatar of sq30

ASKER

Every space character is replaced with the text "&nbsp;"
I understand.  What happens when you press the Save button?
Avatar of sq30

ASKER

If you look at the screen dupms tab of the last file I attached you will see it's knocking the formating/spacing out.
It appears that you are pasting into a proportionally spaced font text area.  Unless you can paste an HTML table or change the destination text are to a mono-spaced font, I don't think there is anything I can do.  I created an HTML file for my testing way back on 7/14 (http:#a40195047 ).  I do not know what your destination page looks like.

What are you trying to accomplish with the data?   Do not reply with a copy/paste answer.  I'm looking for the actual problem (What) you are trying to solve, not a How-to problem definition
Avatar of sq30

ASKER

Then there is no answer.
If you copied a table from a web page and paste it into the page, what does it look like?
Avatar of sq30

ASKER

It stacks each cell on its own line
are you pasting into a textarea or an input type="text"?
Avatar of sq30

ASKER

sorry for the delay was trying to have a pc free day today. I'm believe I'm pasting into a text area and viewing the source code reveals that the page is made up of frames. I cannot see any metion of the font being used and I think you've probably hit the nail on the head with proportionally spaced font text area.
In most modern browsers you can inspect any given element and easily see the HTML and CSS related to that element.  Some will allow you to change the element on the fly.

I think I must be missing something about the transfer of data into the web/server-based application.