Assistance with modifying code to select various columns and group them before paste

willow1985

willow1985

Well-known Member
Joined
Jul 24, 2019
Messages
929
Office Version
  1. 365
Platform
  1. Windows
I am starting a new post for this question as I believe it is a separate question.

Someone on this forum was very generous to give me the following code but my problem with it is I do not know how to modify it to select specific columns and group them.

For example. How would I modify this to copy the data from the "Data" sheet for columns A1:C1 AND F and paste them into the form on the "Central Form" sheet

Note: The code also has a problem with clearing the data on rows when pasting it onto the forms (rows 18, 19 20, 36, 37 and 38 to be exact) that I do not know how to fix - I asked this on my previous post if others need to reference this.

VBA Code: 
Sub PasteToCentralForm3()
    Dim tableRange As Range, destSheet As Worksheet
    Dim tableArray() As Variant, Result() As Variant
    Dim numRows As Long, numCols As Long
    Dim i As Long, j As Long, loopCount As Long
    Dim chunkSize As Long
    CustCol = "A1:C1, F1:F1" 'adjust columns to grab **IT IS NOT GRABBING F!**
   
    Set tableRange = ThisWorkbook.Sheets("Data").ListObjects("Order_Data").DataBodyRange 'Change table name as needed
    Set destSheet = ThisWorkbook.Sheets("Central Form")
    chunkSize = 15 'adjust chunk size as needed.
   
   
    numRows = tableRange.Rows.Count
    numCols = tableRange.Range(CustCol).Columns.Count
    p = 1
    ' Read data into array
    tableArray = tableRange.Value
    ReDim Result(1 To numRows, 1 To numCols)
    For m = 1 To numRows
        If tableArray(m, 2) = "Central" Then
            For n = 1 To numCols
                Result(p, n) = tableArray(m, n)
            Next n
             p = p + 1
        End If
    Next m
   
    Application.ScreenUpdating = False
    loopCount = WorksheetFunction.RoundUp(UBound(Result, 1) / chunkSize, 0)
   
    ' Collect all data into one large array
    Dim outputData() As Variant
    ReDim outputData(1 To loopCount * (chunkSize + 2) - 2, 1 To numCols)
   
    Dim outputIndex As Long
    outputIndex = 1
   
    For i = 1 To loopCount
        Dim outputRowCount As Long
        outputRowCount = WorksheetFunction.Min(chunkSize, numRows - (i - 1) * chunkSize)
        For j = 1 To outputRowCount
            For k = 1 To numCols
                outputData(outputIndex, k) = Result((i - 1) * chunkSize + j, k)
            Next k
            outputIndex = outputIndex + 1
        Next j
        outputIndex = outputIndex + 3 ' Skip three rows for each chunk
    Next i
   
    ' Output all data to destination sheet at once
    destSheet.Cells(3, 1).Resize(UBound(outputData, 1), UBound(outputData, 2)).Value = outputData
   
    Application.ScreenUpdating = True
End Sub

VBA repeat form loop code template2.xlsm
ABCDEFG
1OrderDateRegionRepItemUnitsUnit CostTotal
26-Jan-21EastJonesPencil951.99189.05
323-Jan-21CentralKivellBinder5019.99999.5
49-Feb-21CentralJardinePencil364.99179.64
526-Feb-21CentralGillPen2719.99539.73
615-Mar-21WestSorvinoPencil562.99167.44
71-Apr-21EastJonesBinder604.99299.4
818-Apr-21CentralAndrewsPencil751.99149.25
95-May-21CentralJardinePencil904.99449.1
1022-May-21WestThompsonPencil321.9963.68
118-Jun-21EastJonesBinder608.99539.4
1225-Jun-21CentralMorganPencil904.99449.1
1312-Jul-21EastHowardBinder291.9957.71
1429-Jul-21EastParentBinder8119.991619.19
1515-Aug-21EastJonesPencil354.99174.65
161-Sep-21CentralSmithDesk2125250
1718-Sep-21EastJonesPen Set1615.99255.84
185-Oct-21CentralMorganBinder288.99251.72
1922-Oct-21EastJonesPen648.99575.36
208-Nov-21EastParentPen1519.99299.85
2125-Nov-21CentralKivellPen Set964.99479.04
2212-Dec-21CentralSmithPencil671.2986.43
2329-Dec-21EastParentPen Set7415.991183.26
2415-Jan-22CentralGillBinder468.99413.54
251-Feb-22CentralSmithBinder87151305
2618-Feb-22EastJonesBinder44.9919.96
277-Mar-22WestSorvinoBinder719.99139.93
2824-Mar-22CentralJardinePen Set504.99249.5
2910-Apr-22CentralAndrewsPencil661.99131.34
3027-Apr-22EastHowardPen964.99479.04
3114-May-22CentralGillPencil531.2968.37
3231-May-22CentralGillBinder808.99719.2
3317-Jun-22CentralKivellDesk5125625
344-Jul-22EastJonesPen Set624.99309.38
3521-Jul-22CentralMorganPen Set5512.49686.95
367-Aug-22CentralKivellPen Set4223.951005.9
3724-Aug-22WestSorvinoDesk3275825
3810-Sep-22CentralGillPencil71.299.03
3927-Sep-22WestSorvinoPen761.99151.24
4014-Oct-22WestThompsonBinder5719.991139.43
4131-Oct-22CentralAndrewsPencil141.2918.06
4217-Nov-22CentralJardineBinder114.9954.89
434-Dec-22CentralJardineBinder9419.991879.06
4421-Dec-22CentralAndrewsBinder284.99139.72
Data


VBA repeat form loop code template2.xlsm
ABCDE
1CENTRAL FORM
2OrderDateRegionRepUnit CostNotes
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18Company Name
19CENTRAL FORM
20OrderDateRegionRepUnit CostNotes
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36Company Name
37CENTRAL FORM
38OrderDateRegionRepUnit CostNotes
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54Company Name
55CENTRAL FORM
56OrderDateRegionRepItemNotes
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72Company Name
Central Form
 

Excel Facts

Save Often
If you start asking yourself if now is a good time to save your Excel workbook, the answer is Yes
Sort by date Sort by votes
Do you have "Option Explicit" in your module where the code is?
You might have to adjust for tables.
Code: 
Sub Test()
Dim CustCol As Range
Set CustCol = Range("A1:C1, F1").EntireColumn
CustCol.Select
End Sub
 
Upvote 0
Rather than using Entire Columns, just the Range needed would be better.
Code: 
Sub AAAAA()
Dim CustCol As Range, lr As Long
lr = Cells(Rows.Count, 1).End(xlUp).Row
Set CustCol = Range("A1:C" & lr & ", " & "F1:F" & lr)
CustCol.Select
End Sub
 
Upvote 0
jolivanes said:
Rather than using Entire Columns, just the Range needed would be better.
Code: 
Sub AAAAA()
Dim CustCol As Range, lr As Long
lr = Cells(Rows.Count, 1).End(xlUp).Row
Set CustCol = Range("A1:C" & lr & ", " & "F1:F" & lr)
CustCol.Select
End Sub
Click to expand...

I added what you suggested and get a Run-time error 1004 on line: numCols = tableRange.Range(CustCol).Columns.Count

VBA Code: 
Sub PasteToCentralForm3()
    Dim tableRange As Range, destSheet As Worksheet
    Dim tableArray() As Variant, Result() As Variant
    Dim numRows As Long, numCols As Long
    Dim i As Long, j As Long, loopCount As Long
    Dim chunkSize As Long

'suggested change
Dim CustCol As Range, lr As Long
lr = Cells(Rows.Count, 1).End(xlUp).Row
Set CustCol = Range("A1:C" & lr & ", " & "F1:F" & lr)
CustCol.Select

    
    Set tableRange = ThisWorkbook.Sheets("Data").ListObjects("Order_Data").DataBodyRange 'Change table name as needed
    Set destSheet = ThisWorkbook.Sheets("Central Form")
    chunkSize = 15 'adjust chunk size as needed.
    
    
    numRows = tableRange.Rows.Count
    numCols = tableRange.Range(CustCol).Columns.Count
    p = 1
    ' Read data into array
    tableArray = tableRange.Value
    ReDim Result(1 To numRows, 1 To numCols)
    For m = 1 To numRows
        If tableArray(m, 2) = "Central" Then
            For n = 1 To numCols
                Result(p, n) = tableArray(m, n)
            Next n
             p = p + 1
        End If
    Next m
    
    Application.ScreenUpdating = False
    loopCount = WorksheetFunction.RoundUp(UBound(Result, 1) / chunkSize, 0)
    
    ' Collect all data into one large array
    Dim outputData() As Variant
    ReDim outputData(1 To loopCount * (chunkSize + 2) - 2, 1 To numCols)
    
    Dim outputIndex As Long
    outputIndex = 1
    
    For i = 1 To loopCount
        Dim outputRowCount As Long
        outputRowCount = WorksheetFunction.Min(chunkSize, numRows - (i - 1) * chunkSize)
        For j = 1 To outputRowCount
            For k = 1 To numCols
                outputData(outputIndex, k) = Result((i - 1) * chunkSize + j, k)
            Next k
            outputIndex = outputIndex + 1
        Next j
        outputIndex = outputIndex + 3 ' Skip three rows for each chunk
    Next i
    
    ' Output all data to destination sheet at once
    destSheet.Cells(3, 1).Resize(UBound(outputData, 1), UBound(outputData, 2)).Value = outputData
    
    Application.ScreenUpdating = True
End Sub
 
Upvote 0
Try
VBA Code: 
Sub PasteToCentralForm5()
    Dim tableRange As Range, destSheet As Worksheet
    Dim tableArray() As Variant, Result() As Variant
    Dim numRows As Long, numCols As Long
    Dim i As Long, j As Long, loopCount As Long
    Dim chunkSize As Long
    Set tableRange = ThisWorkbook.Sheets("Data").ListObjects("Table1").DataBodyRange 'Change table name as needed
    Set destSheet = ThisWorkbook.Sheets("Central Form")
    chunkSize = 13 'adjust chunk size as needed.
    numRows = tableRange.Rows.Count
    numCols = 4 ' Columns A, B, C, and F
    p = 1
    ' Read data into array
    tableArray = tableRange.Value
    ReDim Result(1 To numRows, 1 To numCols)
    For m = 1 To numRows
        If tableArray(m, 2) = "Central" Then
            Result(p, 1) = tableArray(m, 1) ' Column A
            Result(p, 2) = tableArray(m, 2) ' Column B
            Result(p, 3) = tableArray(m, 3) ' Column C
            Result(p, 4) = tableArray(m, 6) ' Column F
            p = p + 1
        End If
    Next m
    Application.ScreenUpdating = False
    loopCount = WorksheetFunction.RoundUp(UBound(Result, 1) / chunkSize, 0)
    Dim outputIndex As Long
    Dim rowSkip As Long
    rowSkip = 3 'change # of rows to skip
    outputIndex = 1
    ' Output each chunk of data
    For i = 1 To loopCount
        Dim outputRowCount As Long
        outputRowCount = WorksheetFunction.Min(chunkSize, numRows - (i - 1) * chunkSize)
        Dim outputData() As Variant
        ReDim outputData(1 To outputRowCount, 1 To numCols)
        For j = 1 To outputRowCount
            For k = 1 To numCols
                outputData(j, k) = Result((i - 1) * chunkSize + j, k)
            Next k
        Next j
        ' Output the chunk to destination sheet
        destSheet.Cells(outputIndex + 2, 1).Resize(outputRowCount, numCols).Value = outputData
        outputIndex = outputIndex + outputRowCount + rowSkip ' Move to next chunk
    Next i
    Application.ScreenUpdating = True
End Sub
 
Upvote 0
Solution
Cubist said:
Try
VBA Code: 
Sub PasteToCentralForm5()
    Dim tableRange As Range, destSheet As Worksheet
    Dim tableArray() As Variant, Result() As Variant
    Dim numRows As Long, numCols As Long
    Dim i As Long, j As Long, loopCount As Long
    Dim chunkSize As Long
    Set tableRange = ThisWorkbook.Sheets("Data").ListObjects("Table1").DataBodyRange 'Change table name as needed
    Set destSheet = ThisWorkbook.Sheets("Central Form")
    chunkSize = 13 'adjust chunk size as needed.
    numRows = tableRange.Rows.Count
    numCols = 4 ' Columns A, B, C, and F
    p = 1
    ' Read data into array
    tableArray = tableRange.Value
    ReDim Result(1 To numRows, 1 To numCols)
    For m = 1 To numRows
        If tableArray(m, 2) = "Central" Then
            Result(p, 1) = tableArray(m, 1) ' Column A
            Result(p, 2) = tableArray(m, 2) ' Column B
            Result(p, 3) = tableArray(m, 3) ' Column C
            Result(p, 4) = tableArray(m, 6) ' Column F
            p = p + 1
        End If
    Next m
    Application.ScreenUpdating = False
    loopCount = WorksheetFunction.RoundUp(UBound(Result, 1) / chunkSize, 0)
    Dim outputIndex As Long
    Dim rowSkip As Long
    rowSkip = 3 'change # of rows to skip
    outputIndex = 1
    ' Output each chunk of data
    For i = 1 To loopCount
        Dim outputRowCount As Long
        outputRowCount = WorksheetFunction.Min(chunkSize, numRows - (i - 1) * chunkSize)
        Dim outputData() As Variant
        ReDim outputData(1 To outputRowCount, 1 To numCols)
        For j = 1 To outputRowCount
            For k = 1 To numCols
                outputData(j, k) = Result((i - 1) * chunkSize + j, k)
            Next k
        Next j
        ' Output the chunk to destination sheet
        destSheet.Cells(outputIndex + 2, 1).Resize(outputRowCount, numCols).Value = outputData
        outputIndex = outputIndex + outputRowCount + rowSkip ' Move to next chunk
    Next i
    Application.ScreenUpdating = True
End Sub
Click to expand...

This works great! Thank you so much!
Is there a way to define one more thing? Where to start pasting the data?
For example, if the form starts at cell C13 and that is where I wanted to start pasting the chunks.
Can we make the starting point adjustable?

Thank you again for all of your help!


For example, I changed a few things to apply to another spreadsheet and added in sr for starting row. I just do not know how to do starting column, say column C (3)


VBA Code: 
Sub PasteToCentralForm5()
    Dim tableRange As Range, destSheet As Worksheet
    Dim tableArray() As Variant, Result() As Variant
    Dim numRows As Long, numCols As Long
    Dim i As Long, j As Long, loopCount As Long
    Dim chunkSize As Long
    Set tableRange = ThisWorkbook.Sheets("Data").ListObjects("Data").DataBodyRange 'Change table name as needed
    Set destSheet = ThisWorkbook.Sheets("Part Request Form")
    chunkSize = 20 'adjust chunk size as needed.
    numRows = tableRange.Rows.Count
    numCols = 7 ' Columns A, B, D, F, G, H and I

    p = 1
    ' Read data into array
    tableArray = tableRange.Value
    ReDim Result(1 To numRows, 1 To numCols)
    For m = 1 To numRows
        If tableArray(m, 9) = "S" Then
            Result(p, 1) = tableArray(m, 1) ' Column A
            Result(p, 2) = tableArray(m, 4) ' Column D
            Result(p, 3) = tableArray(m, 2) ' Column B
            Result(p, 4) = tableArray(m, 8) ' Column H
            Result(p, 5) = tableArray(m, 6) ' Column F
            Result(p, 6) = tableArray(m, 7) ' Column G
            Result(p, 7) = tableArray(m, 9) ' Column I

            p = p + 1
        End If
    Next m
    Application.ScreenUpdating = False
    loopCount = WorksheetFunction.RoundUp(UBound(Result, 1) / chunkSize, 0)
    Dim outputIndex As Long
    Dim rowSkip As Long
    rowSkip = 12 'change # of rows to skip
    sr = 12 'Starting row '***added starting row
    outputIndex = 1
    ' Output each chunk of data
    For i = 1 To loopCount
        Dim outputRowCount As Long
        outputRowCount = WorksheetFunction.Min(chunkSize, numRows - (i - 1) * chunkSize)
        Dim outputData() As Variant
        ReDim outputData(1 To outputRowCount, 1 To numCols)
        For j = 1 To outputRowCount
            For k = 1 To numCols
                outputData(j, k) = Result((i - 1) * chunkSize + j, k)
            Next k
        Next j
        ' Output the chunk to destination sheet
        destSheet.Cells(outputIndex + sr, 1).Resize(outputRowCount, numCols).Value = outputData '***added starting row
        outputIndex = outputIndex + outputRowCount + rowSkip ' Move to next chunk
    Next i
    Application.ScreenUpdating = True
End Sub
 
Last edited:
Upvote 0
The 1 is column A. Change to 3 for C.
VBA Code: 
destSheet.Cells(outputIndex + sr, 1).Resize(outputRowCount, numCols).Value = outputData '***added starting row
 
Upvote 0
Cubist said:
The 1 is column A. Change to 3 for C.
VBA Code: 
destSheet.Cells(outputIndex + sr, 1).Resize(outputRowCount, numCols).Value = outputData '***added starting row
Click to expand...

I thought I tried that but guess I made an error because it works now.

Thank you so very much! This is perfect!
 
Upvote 0
You must log in or register to reply here.

Similar threads

A
  • Solved
Select current month in combobox on userform for English language
2 3
Replies
29
Views
320
Ali M
A
S
  • Question Question
AVERAGEIF TROUBLES
Replies
3
Views
79
AhoyNC
A
G
  • Question Question
Copy some specific columns whose header is merge
2 3
Replies
26
Views
672
Joe4
Joe4
J
  • Question Question
auto filling cells based on preset format
Replies
1
Views
35
HighAndWilder
H
J
  • Question Question
adding cells based on criteria across several columns
Replies
5
Views
999
Cubist
Cubist

Forum statistics

Threads
1,224,818
Messages
6,181,152
Members
453,021
Latest member
Justyna P

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top