Copy cell values from row into columns

[ilsley_excel]

Hi,

I am trying to copy dates and amounts (£) from each client row and paste them into column format in a summary table. Each date and amount (£) refers to a card transaction. The verbose table (see VerboseTable.jpg screenshot) holds up to 10 transactions, i.e. up to 10 dates and 10 amounts (3).

Each row represents a client and all their corresponding card transactions (see VerboseTable.jpg screenshot).

I want to create a routine that looks through this table and just copies the client number, client name and any existing card transactions they have into a summary table (see FinalSummaryTable.jpg).

I hope that makes sense!

Any ideas please?

Thanks.

 

[ilsley_excel]

Would it be helpful if I uploaded my Excel workbook?

 

[Fluff]

Cross-posting (posting the same question in more than one forum) is not against our rules, but the method of doing so is covered by #13 of the Forum Rules.

Be sure to follow & read the link at the end of the rule too!

Cross posted at: HELP NEEDED: Copy cell values from row into columns
There is no need to repeat the link(s) provided above but if you have posted the question at other places, please provide links to those as well.

If you do cross-post in the future and also provide links, then there shouldn’t be a problem.

 

[ilsley_excel]

My apologies. I didn't know this.

I have indeed posted the same query here: Excel Help Forum

 

[ilsley_excel]

I'm bumping this up.

Ideally looking for an Excel VBA solution if possible?

Thanks.

 

[kevin9999]

Would it be helpful if I uploaded my Excel workbook?

Yes, it would.

 

[ilsley_excel]

Yes, it would.

This is the verbose table of card transactions:

SampleCardTransactions.xlsx
	A	B	C	D	E	F	G	H	I	J	K	L	M	N	O	P	Q	R	S	T	U	V
1	Client No	Client Name	Date1	Amount1	Date2	Amount2	Date3	Amount3	Date4	Amount4	Date5	Amount5	Date6	Amount6	Date7	Amount7	Date8	Amount8	Date9	Amount9	Date10	Amount10
2	QIS00183	John	07/03/2023	100	09/03/2023	250							12/03/2023	325
3	QIS00184	Mark
4	QIS00185	Helen
5	QIS00186	May
6	QIS00187	Jane	19/04/2023	450
7	QIS00188	Lisa
8	QIS00189	Sarah
9	QIS00190	Harold
10	QIS00191	Ben
11	QIS00192	Kate
12	QIS00193	Jackie
13	QIS00194	Mike
14	QIS00195	Maria	09/05/2023	400	11/05/2023	1000	12/05/2023	550
VerboseTable

This is the output table I need:

SampleCardTransactions.xlsx
	A	B	C	D
2	QIS00183	John	07/03/2023	£100
3	QIS00183	John	09/03/2023	£250
4	QIS00183	John	12/03/2023	£325
5	QIS00187	Jane	19/04/2023	£450
6	QIS00195	Maria	09/05/2023	£400
7	QIS00195	Maria	11/05/2023	£1,000
8	QIS00195	Maria	12/05/2023	£550
FinalSummaryTable

Any ideas?

 

[kevin9999]

Try the following on a copy of your workbook.

Option Explicit
Sub ilsley()
    Dim ws1 As Worksheet, ws2 As Worksheet
    Set ws1 = Worksheets("VerboseTable")
    Set ws2 = Worksheets("FinalSummaryTable")
    
    Dim LRow As Long, n As Long, r As Range, a, b
    LRow = ws1.Cells(Rows.Count, 1).End(xlUp).Row
    Set r = ws1.Range("A1").CurrentRegion.Offset(1).Resize(LRow - 1)
    n = WorksheetFunction.CountA(r.Offset(, 2)) / 2
    
    a = r
    ReDim b(1 To n, 1 To 4)
    Dim i As Long, j As Long, k As Long
    k = 0
    For i = 1 To UBound(a, 1)
        For j = 3 To UBound(a, 2) - 1 Step 2
            If a(i, j) <> "" Then
                k = k + 1
                b(k, 1) = a(i, 1): b(k, 2) = a(i, 2)
                b(k, 3) = a(i, j): b(k, 4) = a(i, j + 1)
            End If
        Next j
    Next i
    
    ws2.Range("A2").Resize(UBound(b, 1), 4).Value = b
End Sub

 

[ilsley_excel]

I will try this shortly. Thanks!

 

[ilsley_excel]

Try the following on a copy of your workbook.

Option Explicit
Sub ilsley()
    Dim ws1 As Worksheet, ws2 As Worksheet
    Set ws1 = Worksheets("VerboseTable")
    Set ws2 = Worksheets("FinalSummaryTable")
   
    Dim LRow As Long, n As Long, r As Range, a, b
    LRow = ws1.Cells(Rows.Count, 1).End(xlUp).Row
    Set r = ws1.Range("A1").CurrentRegion.Offset(1).Resize(LRow - 1)
    n = WorksheetFunction.CountA(r.Offset(, 2)) / 2
   
    a = r
    ReDim b(1 To n, 1 To 4)
    Dim i As Long, j As Long, k As Long
    k = 0
    For i = 1 To UBound(a, 1)
        For j = 3 To UBound(a, 2) - 1 Step 2
            If a(i, j) <> "" Then
                k = k + 1
                b(k, 1) = a(i, 1): b(k, 2) = a(i, 2)
                b(k, 3) = a(i, j): b(k, 4) = a(i, j + 1)
            End If
        Next j
    Next i
   
    ws2.Range("A2").Resize(UBound(b, 1), 4).Value = b
End Sub

This worked perfectly. Sorry for the late reply!

Thanks!