(VBA) Excel - How to transpose variable length columns to rows? - excel

I have an Excel sheet with variable rows but 5 columns.
The final column has comma separated values of varying length.
I have been trying to write a "For Loop" to Transpose this data into Rows while retaining the Data in existing Columns A:D.
Source Data Sample
| User ID | User name | Group ID | Group name | Effective permissions | | | | | |
|---------|-----------|----------|------------|-----------------------|------|------|------|------|------|
| 1 | Adam | 100 | Active | ABCD | RFGE | ERTY | EDFR | | |
| 2 | Bryan | 100 | Bold | IFEU | WASD | WASF | TGRE | YMUN | TYBN |
| 3 | Charles | 100 | Charity | IFLL | ERTY | WSDF | XKLS | | |
| 4 | David | 100 | Danger | IFEU | UNBY | RVBT | ZXCV | XCVB | VBNM |
Output Data Example
| User ID | User name | Group ID | Group name | Effective permissions |
|---------|-----------|----------|------------|-----------------------|
| 1 | Adam | 100 | Active | ABCD |
| 1 | Adam | 100 | Active | RFGE |
| 1 | Adam | 100 | Active | ERTY |
| 1 | Adam | 100 | Active | EDFR |
| 2 | Bryan | 100 | Bold | IFEU |
| 2 | Bryan | 100 | Bold | WASD |
| 2 | Bryan | 100 | Bold | WASF |
| 2 | Bryan | 100 | Bold | TGRE |
| 2 | Bryan | 100 | Bold | YMUN |
| 2 | Bryan | 100 | Bold | TYBN |
| 3 | Charles | 100 | Charity | IFLL |
| 3 | Charles | 100 | Charity | ERTY |
| 3 | Charles | 100 | Charity | WSDF |
| 3 | Charles | 100 | Charity | XKLS |
| 4 | David | 100 | Danger | IFEU |
| 4 | David | 100 | Danger | UNBY |
| 4 | David | 100 | Danger | RVBT |
| 4 | David | 100 | Danger | ZXCV |
| 4 | David | 100 | Danger | XCVB |
| 4 | David | 100 | Danger | VBNM |
Any help you could provide would be greatly appreciated.
**I have completed VBA projects in the past, however I have usually been able to piece together previous examples to achieve my goal...learning along the way.
If someone could show me how to adapt the below code so that each of the values in my first 4 columns are copied down that would be great.
Sub Test()
Set Rng = Sheets("Test").Range("D2:D15")
Set Rng_output = Sheets("Test2").Range("A2")
For i = 1 To Rng.Cells.Count
Set rng_values = Range(Rng.Cells(i).Offset(0, 1), Rng.Cells(i).End(xlToRight))
If rng_values.Cells.Count < 16000 Then
For j = 1 To rng_values.Cells.Count
Rng_output.Value = Rng.Cells(i).Value
Rng_output.Offset(0, 1).Value = rng_values.Cells(j).Value
Set Rng_output = Rng_output.Offset(1, 0)
Next j
End If
Next i
End Sub

You are very close with that code.
Here is the same code, with a few small changes:
Sub Test()
Set Rng = Sheets("Test").Range("D2:D15")
Set Rng_output = Sheets("Test2").Range("A2")
For i = 1 To Rng.Cells.Count
'Test to make sure there is less than 16000 columns in this row past D. Yikes, OP!
Set rng_values = Range(Rng.Cells(i).Offset(0, 1), Rng.Cells(i).End(xlToRight))
If rng_values.Cells.Count < 16000 Then
'Loop through all of those columns
For j = 1 To rng_values.Cells.Count
'Write out value from Column A:D to our Rng_Output
Rng_Output.Value = rng.cells(i).Offset(0,-3).value 'Column A = Column A
Rng_Output.Offset(0,1).Value = rng.cells(i).Offset(0,-2).value 'Column B = Column B
Rng_Output.Offset(0,2).value = rng.cells(i).OFfset(0,-1).value 'etc..
Rng_Output.Offset(0,3).value = rng.cells(i).value
'Write out value from Column A:D to your `Test2` sheet column E
rng_output.Offset(0,1).Value = rng_values.Cells(j).value
'Increment to the next row
Set Rng_output = Rng_output.Offset(1)
Next j
End If
Next i
End Sub

Related

Trying to sum values in a row using VBA and can't solve a bug in code

I have written some VBA to sum the values across columns in a row. I have found however that when i run the code it receives a type mismatch error on random rows and i cannot figure out why. When i delete all other columns except from the four that are to be added it suddenly does not have this error?
I've also noticed that for some reason it does not add the "serving player backhand" column value as it should and i can't figure out why.
Sub sumShotsInRally()
'Set rawData sheet as active
Dim sht1 As Worksheet
Set sht1 = Sheets("Input")
sht1.Activate
'Find the Columns to Add
Dim serverForehandColNum As Integer
serverForehandColNum = ActiveSheet.Rows(1).Find(what:="Serving player forehand", lookat:=xlWhole).Column
Dim serverBackhandColNum As Integer
serverBackhandColNum = ActiveSheet.Rows(1).Find(what:="Serving player backhand", lookat:=xlWhole).Column
Dim returnerForehandColNum As Integer
returnerForehandColNum = ActiveSheet.Rows(1).Find(what:="Returning player forehand", lookat:=xlWhole).Column
Dim returnerBackhandColNum As Integer
returnerBackhandColNum = ActiveSheet.Rows(1).Find(what:="Returning player backhand", lookat:=xlWhole).Column
'Insert two new columns for the x and y
ActiveSheet.Columns(serverForehandColNum + 1).Insert
' Add New col headings
ActiveSheet.Cells(1, serverForehandColNum + 1).Value = "Rally Count"
Dim rallyCountColNum As Integer
rallyCountColNum = ActiveSheet.Rows(1).Find(what:="Rally Count", lookat:=xlWhole).Column
'Split the cell values
'Define the range to iterate over as the used range of the found column
Dim SForehandRange As Range
Dim SBackhandRange As Range
Dim RForehandRange As Range
Dim RBackhandRange As Range
Dim rallyRange As Range
With ActiveSheet
Set SForehandRange = .Range(.Cells(2, serverForehandColNum), .Cells(.UsedRange.Rows.Count, serverForehandColNum))
Set SBackhandRange = .Range(.Cells(2, serverBackhandColNum), .Cells(.UsedRange.Rows.Count, serverBackhandColNum))
Set RForehandRange = .Range(.Cells(2, returnerForehandColNum), .Cells(.UsedRange.Rows.Count, returnerForehandColNum))
Set RBackhandRange = .Range(.Cells(2, returnerBackhandColNum), .Cells(.UsedRange.Rows.Count, returnerBackhandColNum))
Set rallyRange = .Range(.Cells(2, rallyCountColNum), .Cells(.UsedRange.Rows.Count, rallyCountColNum))
End With
Dim results()
'You redimension the results array to the number of entries in your table
ReDim results(1 To SForehandRange.Rows.Count)
'You loop over your table and sum the values from count and restocked
For i = 1 To SForehandRange.Rows.Count
rallyRange(i, 1).Value = SForehandRange(i, 1).Value + SBackhandRange(i, 1).Value + RForehandRange(i, 1).Value + RBackhandRange(i, 1).Value
'results(i) = SForehandRange(i, 1) + SBackhandRange(i, 1) + RForehandRange(i, 1) + RBackhandRange(i, 1)
Next i
'You write the array to the range count and delete the values in restocjed
'rallyRange = Application.Transpose(results)
End Sub
A sample of the table:
+------------------+----------+----------+-------------------+-------------------+------------------+------------+--------------------+-------------------+-------------------+-------------+------------------+------------+------------+--------------------+------------+-----------------+--------------+--------------+-----------+-----------+-----------+---------------+----------------+-----------------+--------------------+-------------------+-------------+----------------------+-----------------------+------------------------+---------------------+---------------------+----------------------+-----------------------+--------------------+---------------+-------------------+--------------+-----------+---------------------+--------------+-------------+---------------------------+-------------------------+---------------+---------------------+----------------------+-----------------------+--------------------+--------------+----------------------+-----------------------+------------------------+---------------------+---------------+---------------------+---------------------------+-------------------------+-----------------------+
| Name | Position | Duration | 1st serve outcome | 1stReturnLocation | 1stServeLocation | 1stServeXY | 2nd return outcome | 2nd return stroke | 2nd serve outcome | 2ndReturnXY | 2ndServeLocation | 2ndServeXY | Date | Final shot outcome | Game score | Opponent player | Point score | Point won by | S/R | Set score | Side | Tagged player | Tiebreak score | Tournament name | 1st return outcome | 1st return stroke | 1stReturnXY | 2nd return+1 outcome | 2nd return+1 position | 2nd return+1 situation | 2nd return+1 stroke | 2nd serve+1 outcome | 2nd serve+1 position | 2nd serve+1 situation | 2nd serve+1 stroke | 2ndReturn+1XY | 2ndReturnLocation | 2ndServe+1XY | Final hit | Final shot position | Final stroke | FinalShotXY | Returning player forehand | Serving player forehand | Type | 1st serve+1 outcome | 1st serve+1 position | 1st serve+1 situation | 1st serve+1 stroke | 1stServe+1XY | 1st return+1 outcome | 1st return+1 position | 1st return+1 situation | 1st return+1 stroke | 1stReturn+1XY | Tagged net approach | Returning player backhand | Serving player backhand | Opponent net approach |
+------------------+----------+----------+-------------------+-------------------+------------------+------------+--------------------+-------------------+-------------------+-------------+------------------+------------+------------+--------------------+------------+-----------------+--------------+--------------+-----------+-----------+-----------+---------------+----------------+-----------------+--------------------+-------------------+-------------+----------------------+-----------------------+------------------------+---------------------+---------------------+----------------------+-----------------------+--------------------+---------------+-------------------+--------------+-----------+---------------------+--------------+-------------+---------------------------+-------------------------+---------------+---------------------+----------------------+-----------------------+--------------------+--------------+----------------------+-----------------------+------------------------+---------------------+---------------+---------------------+---------------------------+-------------------------+-----------------------+
| 0-0 (1) | 329720 | 23520 | Error | Error net | Error net | 38;52 | Error | Forehand | In | 65;54 | Wide | 32;38 | 20/08/2011 | Forced error | 00:00 | Player 2 | 0-0 | Player | Serving | Set 1 | Deuce | Player 1 | 00:00 | Repton | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | |
| 15-0 (1) | 375000 | 4720 | In | Error long | Body | 60;32 | | | | | | | 20/08/2011 | Unforced error | 00:00 | Player 2 | 15-0 | Player | Serving | Set 1 | Advantage | Player 1 | 00:00 | Repton | Error | Backhand | 65;5 | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | |
| 30-0 (1) | 393320 | 17440 | Error | | Error net | 44;51 | In | Forehand | In | 57;27 | Body | 42;34 | 20/08/2011 | Unforced error | 00:00 | Player 2 | 30-0 | Player | Serving | Set 1 | Deuce | Player 1 | 00:00 | Repton | | | | In | Middle baseline | Neutral | Backhand | In | Middle baseline | Neutral | Forehand | 59;28 | Middle | 61;27 | Player 1 | Middle baseline | Forehand | 39;28 | 1 | 1 | Ground stroke | | | | | | | | | | | | | | |
| 40-0 (1) | 428640 | 6360 | In | Middle | Wide | 66;36 | | | | | | | 20/08/2011 | | 00:00 | Player 2 | 40-0 | Player | Serving | Set 1 | Advantage | Player 1 | 00:00 | Repton | In | Backhand | 46;20 | | | | | | | | | | | | | | | | | | | Unforced error | Middle baseline | Neutral | Forehand | 48;29 | | | | | | | | | |
| 40-15 (1) | 450800 | 9840 | In | Middle | Wide | 34;34 | | | | | | | 20/08/2011 | Unforced error | 00:00 | Player 2 | 40-15 | Player | Serving | Set 1 | Deuce | Player 1 | 00:00 | Repton | In | Forehand | 55;28 | | | | | | | | | | | | Player 1 | Middle transition | Forehand | 69;50 | | 1 | Approach shot | In | Middle baseline | Neutral | Forehand | 57;28 | In | Middle baseline | Neutral | Backhand | 69;23 | Yes | | | |
| 40-30 (1) | 485280 | 6680 | In | Middle | Body | 60;33 | | | | | | | 20/08/2011 | | 00:00 | Player 2 | 40-30 | Player | Serving | Set 1 | Advantage | Player 1 | 00:00 | Repton | In | Backhand | 59;34 | | | | | | | | | | | | | | | | | | | Unforced error | Middle inside | Neutral | Forehand | 70;36 | | | | | | | | | |
| SD advantage (1) | 523800 | 4880 | In | Error long | Wide | 64;31 | | | | | | | 20/08/2011 | Unforced error | 00:00 | Player 2 | SD advantage | Player | Serving | Set 1 | Advantage | Player 1 | 00:00 | Repton | Error | Backhand | 48;8 | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | |
| 0-0 (2) | 577560 | 5520 | In | Middle | Wide | 33;30 | | | | | | | 20/08/2011 | | 01:00 | Player 2 | 0-0 | Player | Returning | Set 1 | Deuce | Player 1 | 00:00 | Repton | In | Forehand | 59;30 | | | | | | | | | | | | | | | | | | | Unforced error | Middle inside | Attacking | Backhand | 57;37 | | | | | | | | | |
| 0-15 (1) | 609040 | 11800 | In | Middle | Body | 61;30 | | | | | | | 20/08/2011 | Winner | 01:00 | Player 2 | 0-15 | Player | Returning | Set 1 | Advantage | Player 1 | 00:00 | Repton | In | Backhand | 57;29 | | | | | | | | | | | | Player 1 | Middle baseline | Forehand | 28;27 | 1 | 1 | Ground stroke | In | Advantage wide | Attacking | Forehand | 75;37 | In | Middle baseline | Neutral | Forehand | 42;27 | | | | |
+------------------+----------+----------+-------------------+-------------------+------------------+------------+--------------------+-------------------+-------------------+-------------+------------------+------------+------------+--------------------+------------+-----------------+--------------+--------------+-----------+-----------+-----------+---------------+----------------+-----------------+--------------------+-------------------+-------------+----------------------+-----------------------+------------------------+---------------------+---------------------+----------------------+-----------------------+--------------------+---------------+-------------------+--------------+-----------+---------------------+--------------+-------------+---------------------------+-------------------------+---------------+---------------------+----------------------+-----------------------+--------------------+--------------+----------------------+-----------------------+------------------------+---------------------+---------------+---------------------+---------------------------+-------------------------+-----------------------+
Sum Up Cells to Array
This is how I understand it at the moment. Try it and get back to me in the comments to fix possible issues.
The Code
Option Explicit
Sub sumShotsInRally()
'Set rawData sheet as active
Dim ws As Worksheet
Set ws = Sheets("Input")
'Find first column to sum
Dim sForeCol As Long
sForeCol = ws.Rows(1).Find(What:="Serving player forehand", _
Lookat:=xlWhole).Column
'Add Rally Count Column.
Dim rallyCountCol As Long
rallyCountCol = sForeCol + 1
ws.Columns(rallyCountCol).Insert
ws.Cells(1, rallyCountCol).Value = "Rally Count"
'Find remaining columns to sum
Dim sBackCol As Long
sBackCol = ws.Rows(1).Find(What:="Serving player backhand", _
Lookat:=xlWhole).Column
Dim rForeCol As Long
rForeCol = ws.Rows(1).Find(What:="Returning player forehand", _
Lookat:=xlWhole).Column
Dim rBackCol As Long
rBackCol = ws.Rows(1).Find(What:="Returning player backhand", _
Lookat:=xlWhole).Column
'Define the range to iterate over as the used range of the found column
Dim sFore As Range
Dim sBack As Range
Dim rFore As Range
Dim rBack As Range
Dim RallyCount As Range
'Define column ranges
With ws
Set sFore = .Range(.Cells(2, sForeCol), _
.Cells(.UsedRange.Rows.Count, sForeCol))
Set sBack = .Range(.Cells(2, sBackCol), _
.Cells(.UsedRange.Rows.Count, sBackCol))
Set rFore = .Range(.Cells(2, rForeCol), _
.Cells(.UsedRange.Rows.Count, rForeCol))
Set rBack = .Range(.Cells(2, rBackCol), _
.Cells(.UsedRange.Rows.Count, rBackCol))
Set RallyCount = .Range(.Cells(2, rallyCountCol), _
.Cells(.UsedRange.Rows.Count, rallyCountCol))
End With
'Define Results Array
Dim Results As Variant
'You redimension the results array to the number of entries in your table
ReDim Results(1 To sFore.Rows.Count, 1 To 1)
'You loop over your table and sum the values from count and restocked
For i = 1 To sFore.Rows.Count
Results(i, 1) = sFore(i, 1) + sBack(i, 1) + rFore(i, 1) + rBack(i, 1)
Next i
'You write the array to the range count and delete the values in restocjed
RallyCount.Value = Results
End Sub

Excel dynamic range in matrix

In my excel worksheet I have a matrix like this:
+---+------------+--------+--------+--------+--------+--------+-------+
| * | A | B | C | D | E | F | Col n |
+---+------------+--------+--------+--------+--------+--------+-------+
| 1 | 01/01/2000 | -1.000 | -1.000 | -1.000 | -1.000 | -1.000 | ... |
| 2 | 01/02/2000 | | 1.200 | 500 | 500 | 500 | ... |
| 3 | 01/03/2001 | | | 1.100 | 800 | 800 | ... |
| 4 | 01/04/2000 | | | | 1.000 | 700 | ... |
| 5 | 01/05/2000 | | | | | 900 | ... |
| 6 | 01/06/2000 | | | | | | ... |
| 7 | 01/07/2000 | | | | | | ... |
+---+------------+--------+--------+--------+--------+--------+-------+
I need a formula for each column (from column 2) with a dynamic range like this:
For Column B:
=XIRR(B1:B1,A1:A1)
For Column C:
=XIRR(C1:C2,A1:A2)
For Column D:
=XIRR(D1:D3,A1:A3)
For Column E:
=XIRR(E1:E4,A1:A4)
and so on.
Is it possible?
Thanks
I think what you are after is:
=XIRR(OFFSET(B$1,0,0,COLUMN()-1),OFFSET($A$1,0,0,COLUMN()-1))
Using OFFSET we can specify the number of rows in our offset range... We can use the COLUMN() number -1 to get 1 for B, 2 for C etc. We start the offset from an unfixed cell for the values (so it moves along the columns) and a fixed one for dates (so it stays in A)
This formula can just be copied along the cells as far as necessary...

Excel 2010: Moving cell right & up from original location (Offsetting it)

Program: Excel 2010
Experience Basic
Issue:
I have a large table of data with some "split cells" (first/last name & currency), this is how it is from the original data (copied & pasted from a webpage, the data is split in 2). I need to make a clean table with all data on 1 row, not 2. I have some sample data below, and then further down I have included how I want it to look like.
The original formatting is a HTML table, pulled from a database (which I do NOT have access to, however I can generate a CSV but that in itself is another question due to how it is setup.)
Assume: Data in (A1); there are more than the listed values & columns, and I will accept either formula OR VBA answers and lastly: Ignore the blank rows, they were inserted to show the difference between tables more clearly.
Original Data:
| Date | Transaction ID | Order Reference | Sender | Sender Email | Status | Payment Amount | Amount Paid |
|------------|----------------|-----------------|--------|--------------|--------|----------------|-------------|
| 17/04/2014 | transid | order | first | email | Paid | 5 | 5 |
| | | | last | | | AUD | AUD |
| | | | | | | | |
| 13/04/2014 | transid | order | first | email | Paid | 5 | 5 |
| | | | last | | | AUD | AUD |
| | | | | | | | |
| 13/04/2014 | transid | order | first | email | Paid | 5 | 5 |
| | | | last | | | AUD | AUD |
| | | | | | | | |
| 12/04/2014 | transid | order | first | email | Paid | 5 | 5 |
| | | | last | | | AUD | AUD |
Required Data: (notice the first/last are now on the same row as is the currency)
| Date | Transaction ID | Order Reference | Sender | | Sender Email | Status | Payment Amount | | Amount Paid | |
|------------|----------------|-----------------|--------|------|--------------|--------|----------------|-----|-------------|-----|
| 17/04/2014 | transid | order | first | last | email | Paid | 5 | AUD | 5 | AUD |
| | | | | | | | | | | |
| 13/04/2014 | transid | order | first | last | email | Paid | 5 | AUD | 5 | AUD |
| | | | | | | | | | | |
| 13/04/2014 | transid | order | first | last | email | Paid | 5 | AUD | 5 | AUD |
| | | | | | | | | | | |
| 12/04/2014 | transid | order | first | last | email | Paid | 5 | AUD | 5 | AUD |
Thank you, have a great weekend.
[EDIT]
Note, none of these cells are merged, each cell is an individual, and the "last" & "AUD" need to be moved right & up.
This should work for you:
Public Sub ModData()
Dim colDate As Long
Dim colTrans As Long
Dim colOrder As Long
Dim colSender As Long
Dim colSenderEmail As Long
Dim colStatus As Long
Dim colPmtAmt As Long
Dim colPaid As Long
Dim r As Long
Dim ws As Worksheet
colDate = 1
colTrans = 2
colOrder = 3
colSender = 4
' col 5 reserved for inserted col
colSenderEmail = 6
colStatus = 7
colPmtAmt = 8
' col 9 reserved for inserted col
colPaid = 10
Set ws = ActiveSheet
Application.ScreenUpdating = False
' Add extra columns needed.
ws.Columns(colSender + 1).Insert Shift:=xlToRight
ws.Columns(colPmtAmt + 1).Insert Shift:=xlToRight
' Move data to same row.
For r = 2 To 12 Step 2
ws.Cells(r, colSender + 1).Value = ws.Cells(r + 1, colSender).Value
ws.Cells(r, colPmtAmt + 1).Value = ws.Cells(r + 1, colPmtAmt).Value
ws.Cells(r, colPaid + 1).Value = ws.Cells(r + 1, colPaid).Value
Next r
' Delete unnecessary rows.
r = 3
While ws.Cells(r - 1, 1).Value <> ""
ws.Cells(r, 1).EntireRow.Delete
r = r + 1
Wend
Application.ScreenUpdating = True
End Sub

Create columns from column values in Excel

I have a data in Excel:
+-----------------------------+--------------------+----------+
| Name | Category | Number |
+-----------------------------+--------------------+----------+
| Alex | Portret | 3 |
| Alex | Other | 2 |
| Serge | Animals | 1 |
| Serge | Portret | 4 |
+-----------------------------+--------------------+----------+
And I want to transform it to:
+-----------+-----------+-------+---------+
| Name | Portret | Other | Animals |
+-----------+-----------+-------+---------+
| Alex | 3 | 2 | 0 |
| Serge | 4 | 0 | 1 |
+-----------+-----------+-------+---------+
How can I do it in MS Excel ?
You can use a pivot table for that
Take a look at http://office.microsoft.com/en-gb/excel-help/pivottable-reports-101-HA001034632.aspx

How to get QTP and Excel to sort correctly?

I need to sort by columns a ascending, then b ascending, then d ascending and by columns e ascending, then f ascending, then h ascending. Using just QTP, I can't seem to get Excel to sort the data correctly.
What I want:
Table 1:
| a | b | c | d | e | f | g | h |
---------------------------------------------------------------------
| 1 | BE | blank | 51 stuff | 1 | BE | blank | 51 stuff |
| 1 | BE | blank | 100 stuff | 1 | BE | blank | 100 stuff |
| 1 | BE OF A | blank | 121 stuff | 1 | BE OF A | blank | 121 stuff |
| 1 | BE OF A | blank | 200 stuff | 1 | BE OF A | blank | 200 stuff |
| 2 | SEA | blank | 5 stuff | 1 | SEA | blank | 5 stuff |
What I got instead:
Table 2:
| a | b | c | d | e | f | g | h |
---------------------------------------------------------------------
| 1 | BE | blank | 100 stuff | 1 | BE OF A | blank | 121 stuff |
| 1 | BE | blank | 51 stuff | 1 | BE OF A | blank | 200 stuff |
| 1 | BE OF A | blank | 121 stuff | 1 | BE | blank | 100 stuff |
| 1 | BE OF A | blank | 200 stuff | 1 | BE | blank | 51 stuff |
| 2 | SEA | blank | 5 stuff | 1 | SEA | blank | 5 stuff |
Columns e through h gets populated and sorted first. Normally, the cells for those columns are populated in the correct sort order seen in Table 1. However, there have been instances where the sort order is incorrect, but that is rare. Maybe 1 out of 100,000 tries would it be populated with unsorted data.
Columns a through d gets populated and sorted last. The cells for those columns are populated in a somewhat haphazard manner. Table 3 illustrates a very simple end result without forcing a sort.
Table 3:
| a | b | c | d | e | f | g | h |
---------------------------------------------------------------------
| 1 | BE | blank | 100 stuff | 1 | BE | blank | 51 stuff |
| 1 | BE | blank | 51 stuff | 1 | BE | blank | 100 stuff |
| 1 | BE OF A | blank | 121 stuff | 1 | BE OF A | blank | 121 stuff |
| 1 | BE OF A | blank | 200 stuff | 1 | BE OF A | blank | 200 stuff |
| 2 | SEA | blank | 5 stuff | 1 | SEA | blank | 5 stuff |
What's the best way to get QTP and Excel to return the results displayed in Table 1? Is there even a way to?
Snippet of the code(s) that I'm using:
'Some Code Stuff here which leads to exporting the worksheet
rangeOne = "E1:H" & totalRowCnt
Set rangeObj = worksheetOne.Range(rangeOne)
Set range1 = excel1Obj.Range("E1")
Set range2 = excel1Obj.Range("F1")
Set range3 = excel1Obj.Range("H1")
rangeObj.Sort range1, ascend1, range2, ,ascend1, range3, ,ascend1,yes1
'Save worksheet then import sorted data back into Datatable
'and add more Code Stuff here which leads to exporting the worksheet again
rangeOne = "A1:D" & totalRowCnt
Set rangeObj = worksheetOne.Range(rangeOne)
Set range1 = excel1Obj.Range("A1")
Set range2 = excel1Obj.Range("B1")
Set range3 = excel1Obj.Range("D1")
rangeObj.Sort range1, ascend1, range2, ,ascend1, range3, ,ascend1,yes1
'Save worksheet then end script
Try loading the data into a Recordset object. You can sort the recordset like this:
rs.Sort = "a ASC, b ASC, d ASC, e ASC, f ASC, h ASC"
then copy the sorted data to Excel or write them to a CSV.
rs.MoveFirst
Do Until rs.EOF
For i = 0 To rs.Fields.Count - 1
'copy/write rs.Fields(i).Value
Next
rs.MoveNext
Loop

Resources