Two Tabs, Header of invoice on one tab, lines on second, how to split 600 000 lines in to 30k groups each.

W

walkes

New Member
Joined
Jan 29, 2022
Messages
5
Office Version
  1. 365
Platform
  1. Windows
Hi There,


I have big excel files with 600 000+ lines, I have to split those 600 000 in to 30 000 lines each base on the invoice number sourced in second tab. Selected 30k I have to past into new file.

For now I am counting lines on the invoice and sum the up till I reach around 30 000k (each invoice has different number of lines).

On tab One I have for example F/2022/01/29 and on the second tab I mark all lines with this reference.

I know that full operation would be a long piece but could you help me with macro which will count lines as close as possible to 30k then highlight with one color then start again mark it with second color till it reach the end?

Best Regards,
Waldo
 

Excel Facts

Create a chart in one keystroke
Select the data and press Alt+F1 to insert a default chart. You can change the default chart to any chart type
Sort by date Sort by votes
Do you want to give each cell (in a certain column) of your 2nd sheet a color if they match with a value on the first? That can be done with conditional formatting, but what has that 30k to do with it ?
How does your data look like (approx. 5-10 lines of that column in your 2nd sheet, with XL2BB)
 
Upvote 0
BSALV said:
Do you want to give each cell (in a certain column) of your 2nd sheet a color if they match with a value on the first? That can be done with conditional formatting, but what has that 30k to do with it ?
How does your data look like (approx. 5-10 lines of that column in your 2nd sheet, with XL2BB)
Click to expand...
First tab has header of Invoice. Second Tab has lines of the invoice. For Example:
Invoice Header: Number of the invoice; Customer Name; Date of issuing
Invoice lines: Number of the invoice; Name of the product; price

Zeszyt1
ABCDEFGHIJKLMNO
1Fiest Tab
2 F/2022/01/29/1Microsoft29.01.20205<-- how many lines on each invoice
3 F/2022/01/29/2Apple30.01.20204
4 F/2022/01/29/3Ricoch31.01.20202
511<-- eleven lines in total
6
7
8Secon tab
9If I want to copy each 10 lines, macro should higlight olny two first, then start counting and mark next 10
10 F/2022/01/29/1Laptop1000,00
11 F/2022/01/29/1HDD500,00
12 F/2022/01/29/1mouse20,00
13 F/2022/01/29/1monitor200,00
14 F/2022/01/29/1CD50,00
15 F/2022/01/29/2Laptop1000,00
16 F/2022/01/29/2HDD500,00
17 F/2022/01/29/2CD50,00
18 F/2022/01/29/2mouse20,00
19 F/2022/01/29/3monitor200,00
20 F/2022/01/29/3CD50,00
21
22
Arkusz1
 
Upvote 0
for now 5 instead of 30,000
VBA Code: 
Sub Color30k()
     Dim iInterval
     iInterval = 5                                              'temporary every 5th line, later 30000

     arr1 = Sheets("blad3").Range("a1").CurrentRegion           'your 1th tab with the invoices numbers, temporary nothing done with it

     With Sheets("blad2")                                       'your 2nd tab with +600,000 rows
          .UsedRange.Interior.Color = xlNone                    'no backgroundcolor
          .UsedRange.Borders.LineStyle = xlNone                 'no lines
          r = .UsedRange.Row + .UsedRange.Rows.Count + 1        'rownumber of the last row
          arr2 = .Range("A1").Resize(r)                         'read column A to array

          For i = 2 To r                                        'loop through all rowq
               If arr2(i, 1) <> arr2(i - 1, 1) Then             'new invoice
                    ptr = 1                                     'reset pointer
                    With .Cells(i, 1).EntireRow.Borders(xlEdgeTop)     'add a line above new invoicenumber
                         .LineStyle = xlContinuous              'continuous
                         .Color = RGB(255, 0, 0)                'red
                         .Weight = xlThick                      'thick
                    End With
               Else
                    ptr = ptr + 1                               'increment pointer
               End If

               If (ptr Mod iInterval) = 0 Then                  'at every multiple of iInterval for the pointer
                    With .Cells(i, 1).EntireRow.Borders(xlEdgeBottom)     'Add a line at the bottom
                         .LineStyle = xlContinuous              'continuous
                         .Color = RGB(0, 0, 0)                  'black
                         .Weight = xlThick                      'thick
                    End With
               End If

               If (ptr - 1) Mod iInterval <= 1 Then .Cells(i, 1).Interior.Color = IIf(((1 + ptr) \ iInterval) Mod 2, RGB(0, 200, 255), RGB(0, 255, 0))     'alternative blue/green color after xth invoice
          Next
     End With
End Sub

Map2
ABC
1
2 F/2022/01/29/1Laptop1000
3 F/2022/01/29/1HDD500
4 F/2022/01/29/1mouse20
5 F/2022/01/29/1Laptop-473
6 F/2022/01/29/1HDD-963
7 F/2022/01/29/1mouse-1453
8 F/2022/01/29/1Laptop-1943
9 F/2022/01/29/1HDD-2433
10 F/2022/01/29/1mouse-2923
11 F/2022/01/29/1Laptop-3413
12 F/2022/01/29/1HDD-3903
13 F/2022/01/29/1mouse-4393
14 F/2022/01/29/1
15 F/2022/01/29/1Laptop-4883
16 F/2022/01/29/1CD50
17 F/2022/01/29/2Laptop1000
18 F/2022/01/29/2HDD500
19 F/2022/01/29/2CD50
20 F/2022/01/29/2mouse20
21 F/2022/01/29/3monitor200
22 F/2022/01/29/3CD50
23 F/2022/01/29/3monitor-100
24 F/2022/01/29/3CD-250
25 F/2022/01/29/3monitor-400
26 F/2022/01/29/3CD-550
27 F/2022/01/29/3monitor-700
28 F/2022/01/29/3CD-850
29 F/2022/01/29/3monitor-1000
30 F/2022/01/29/3CD-1150
31 F/2022/01/29/3monitor-1300
32 F/2022/01/29/3CD-1450
33 F/2022/01/29/3monitor-1600
34 F/2022/01/29/3CD-1750
35 F/2022/01/29/3monitor-1900
36 F/2022/01/29/3CD-2050
37 F/2022/01/29/3monitor-2200
38 F/2022/01/29/3CD-2350
39 F/2022/01/29/3monitor-2500
40 F/2022/01/29/3CD-2650
Blad2
 
Upvote 0
BSALV said:
Sub Color30k() Dim iInterval iInterval = 5 'temporary every 5th line, later 30000 arr1 = Sheets("blad3").Range("a1").CurrentRegion 'your 1th tab with the invoices numbers, temporary nothing done with it With Sheets("blad2") 'your 2nd tab with +600,000 rows .UsedRange.Interior.Color = xlNone 'no backgroundcolor .UsedRange.Borders.LineStyle = xlNone 'no lines r = .UsedRange.Row + .UsedRange.Rows.Count + 1 'rownumber of the last row arr2 = .Range("A1").Resize(r) 'read column A to array For i = 2 To r 'loop through all rowq If arr2(i, 1) <> arr2(i - 1, 1) Then 'new invoice ptr = 1 'reset pointer With .Cells(i, 1).EntireRow.Borders(xlEdgeTop) 'add a line above new invoicenumber .LineStyle = xlContinuous 'continuous .Color = RGB(255, 0, 0) 'red .Weight = xlThick 'thick End With Else ptr = ptr + 1 'increment pointer End If If (ptr Mod iInterval) = 0 Then 'at every multiple of iInterval for the pointer With .Cells(i, 1).EntireRow.Borders(xlEdgeBottom) 'Add a line at the bottom .LineStyle = xlContinuous 'continuous .Color = RGB(0, 0, 0) 'black .Weight = xlThick 'thick End With End If If (ptr - 1) Mod iInterval <= 1 Then .Cells(i, 1).Interior.Color = IIf(((1 + ptr) \ iInterval) Mod 2, RGB(0, 200, 255), RGB(0, 255, 0)) 'alternative blue/green color after xth invoice Next End With End Sub
Click to expand...

Thank you, still in the "lines" there is a glitch it marks only two first lines leaving rest unmarked. there could be up to 2k lines for one invoice.
 
Upvote 0
this code colors a complete block of 5 cells (later 30k, modify iInterval).
As extra, it creates a new sheet and copies that block to that new sheet
VBA Code: 
Sub Color30k()
     Dim iInterval, bNew, bMod, cStart As Range, bColor As Boolean, sh As Worksheet
     '-----------------------------------------------------------------------------------------------------------------
     ' MAKE iINTERVAL LATER 30,000 OR ANOTHER VALUE
     '---------------------------------------------------------------------------------------------------------------
     iInterval = 5                                              'temporary every 5th line, later 30000

     arr1 = Sheets("blad1").Range("a1").CurrentRegion           'your 1th tab with the invoices numbers, temporary nothing done with it

     With Sheets("blad2")                                       'your 2nd tab with +600,000 rows
          .Cells.Interior.Color = xlNone                        'no backgroundcolor
          .Cells.Borders.LineStyle = xlNone                     'no lines
          r = .Range("A" & Rows.Count).End(xlUp).Row            'rownumber of the last row
          arr2 = .Range("A1").Resize(r)                         'read column A to array

          For i = 2 To r + 1                                    'loop through all rowq
               If i = r + 1 Then bNew = 1 Else bNew = (arr2(i, 1) <> arr2(i - 1, 1))     'new invoice or last line+1
               bMod = ((ptr Mod iInterval) = 0)                 'at every multiple of iInterval for the pointer+1
               If bNew Then ptr = 1 Else ptr = ptr + 1          'reset or increment pointer

               If bMod Or bNew Then                             'you need action ?
                    With .Cells(i, 1).EntireRow.Borders(xlEdgeTop)     'Add a line at the top
                         .LineStyle = xlContinuous              'continuous
                         .Color = IIf(bNew, RGB(255, 0, 0), RGB(0, 0, 0))     'black if within an existing invoice, red for a new invoice
                         .Weight = xlThick                      'thick
                    End With

                    If Not cStart Is Nothing Then               'exept for 1st loop
                         With cStart.Resize(i - bNew - cStart.Row + 1)     'range that must recieve a color
                              .Interior.Color = IIf(bColor, RGB(0, 200, 255), RGB(0, 255, 0))     'alternative blue/green color
                              bColor = Not bColor               'flipflop for your color

                              Sheets.Add after:=Sheets(Sheets.Count)     'add a new sheet after the last one
                              s = Replace(CStr(arr2(i - 1, 1)), "/", "_")     'name for that sheet (/ isn't allowed in a sheetname)
                              For i1 = 1 To 100                 'loop indexnumber
                                   s1 = s & Format(i1, "\(00\)")     'future name
                                   On Error Resume Next
                                   Set sh = Nothing: Set sh = Sheets(s1)     'check if sheet exists already
                                   On Error GoTo 0
                                   If sh Is Nothing Then ActiveSheet.Name = s1: Exit For     'give new sheet a not existing name
                              Next
                              .Resize(, 26).Copy ActiveSheet.Range("A1")     'copy that block to your new sheet

                         End With
                    End If

                    Set cStart = .Cells(i, 1)                   'startcell for next block
               End If
          Next
     End With
End Sub
test39.xlsm
ABCD
1
2 F/2022/01/29/1Laptop1000
3 F/2022/01/29/1HDD500
4 F/2022/01/29/1Laptop0
5 F/2022/01/29/1HDD-500
6 F/2022/01/29/1Laptop-1000
7 F/2022/01/29/1HDD-1500
8 F/2022/01/29/1Laptop-2000
9 F/2022/01/29/1HDD-2500
10 F/2022/01/29/1Laptop-3000
11 F/2022/01/29/1Laptop-3000
12 F/2022/01/29/1Laptop-473.333.333.333.333
13 F/2022/01/29/1HDD-963.333.333.333.333
14 F/2022/01/29/1mouse-145.333.333.333.333
15 F/2022/01/29/1Laptop-194.333.333.333.333
16 F/2022/01/29/1HDD-243.333.333.333.333
17 F/2022/01/29/1mouse-292.333.333.333.333
18 F/2022/01/29/1Laptop-341.333.333.333.333
19 F/2022/01/29/1HDD-390.333.333.333.333
20 F/2022/01/29/1mouse-439.333.333.333.333
21 F/2022/01/29/1
22 F/2022/01/29/1Laptop-488.333.333.333.333
23 F/2022/01/29/1CD50
24 F/2022/01/29/2Laptop1000
25 F/2022/01/29/2HDD500
26 F/2022/01/29/2CD50
27 F/2022/01/29/2mouse20
28 F/2022/01/29/3monitor200
29 F/2022/01/29/3CD50
30 F/2022/01/29/3monitor-100
31 F/2022/01/29/3CD-250
32 F/2022/01/29/3monitor-400
33 F/2022/01/29/3CD-550
34 F/2022/01/29/3monitor-700
35 F/2022/01/29/3CD-850
36 F/2022/01/29/3monitor-1000
37 F/2022/01/29/3CD-1150
38 F/2022/01/29/3monitor-1300
39 F/2022/01/29/3CD-1450
40 F/2022/01/29/3monitor-1600
41 F/2022/01/29/3CD-1750
42 F/2022/01/29/3monitor-1900
43 F/2022/01/29/3CD-2050
44 F/2022/01/29/3monitor-2200
45 F/2022/01/29/3CD-2350
46 F/2022/01/29/3monitor-2500
47 F/2022/01/29/3CD-2650
48
Blad2
 
Upvote 0
it was too late to make a small adjustment to the macro, so in a new post
VBA Code: 
Sub Color30k()
     Dim iInterval, bNew, bMod, cStart As Range, bColor As Boolean, sh As Worksheet
     '-----------------------------------------------------------------------------------------------------------------
     ' MAKE iINTERVAL LATER 30,000 OR ANOTHER VALUE
     '---------------------------------------------------------------------------------------------------------------
     iInterval = 5                                              'temporary every 5th line, later 30000

     arr1 = Sheets("blad1").Range("a1").CurrentRegion           'your 1th tab with the invoices numbers, temporary nothing done with it

     With Sheets("blad2")                                       'your 2nd tab with +600,000 rows
          .Cells.Interior.Color = xlNone                        'no backgroundcolor
          .Cells.Borders.LineStyle = xlNone                     'no lines
          r = .Range("A" & Rows.Count).End(xlUp).Row            'rownumber of the last row
          arr2 = .Range("A1").Resize(r)                         'read column A to array

          For i = 2 To r + 1                                    'loop through all rowq
               If i = r + 1 Then bNew = 1 Else bNew = (arr2(i, 1) <> arr2(i - 1, 1))     'new invoice or last line+1
               bMod = ((ptr Mod iInterval) = 0)                 'at every multiple of iInterval for the pointer+1
               If bNew Then ptr = 1 Else ptr = ptr + 1          'reset or increment pointer

               If bMod Or bNew Then                             'you need action ?
                    With .Cells(i, 1).EntireRow.Borders(xlEdgeTop)     'Add a line at the top
                         .LineStyle = xlContinuous              'continuous
                         .Color = IIf(bNew, RGB(255, 0, 0), RGB(0, 0, 0))     'black if within an existing invoice, red for a new invoice
                         .Weight = xlThick                      'thick
                    End With

                    If Not cStart Is Nothing Then               'exept for 1st loop
                         With cStart.Resize(i - cStart.Row)       'range that must recieve a color
                              .Interior.Color = IIf(bColor, RGB(0, 200, 255), RGB(0, 255, 0))     'alternative blue/green color
                              bColor = Not bColor               'flipflop for your color

                              Sheets.Add after:=Sheets(Sheets.Count)     'add a new sheet after the last one
                              s = Replace(CStr(arr2(i - 1, 1)), "/", "_")     'name for that sheet (/ isn't allowed in a sheetname)
                              For i1 = 1 To 100                 'loop indexnumber
                                   s1 = s & Format(i1, "\(00\)")     'future name
                                   On Error Resume Next
                                   Set sh = Nothing: Set sh = Sheets(s1)     'check if sheet exists already
                                   On Error GoTo 0
                                   If sh Is Nothing Then ActiveSheet.Name = s1: Exit For     'give new sheet a not existing name
                              Next
                              .Resize(, 26).Copy ActiveSheet.Range("A1")     'copy that block to your new sheet

                         End With
                    End If

                    Set cStart = .Cells(i, 1)                   'startcell for next block
               End If
          Next
     End With
End Sub
 
Upvote 0
WoW, I owe you a few beers :D, It's awesome, this time it's almost what I need, the missing part is creation of the tab. In above scrip there is a new tab for each invoice instead of each tab for 30k lines.
Name of the tab, could be tab One, two, three, etc.
 
Upvote 0
1. i wrote it in the macro, make that 5 30000.
2. make the tabnames, one, two, three
That's possible, but not today or for somebody else.
 

Attachments

  • Schermafbeelding 2022-01-30 175844.png
    Schermafbeelding 2022-01-30 175844.png
    16.1 KB · Views: 5
Upvote 0
You must log in or register to reply here.

Similar threads

R
  • Question
Split row into two rows, one header and one line row
Replies
2
Views
60
rrmando18
R
R
  • Locked
  • Question
How do I automaticaly transfer data from Columns to lines
Replies
3
Views
313
russelldt
R
P
  • Solved
Split one row with a value into multiple lines to add up to this value
Replies
3
Views
324
I_know_nuffin
I
H
  • Question
Macro: Convert pdf into Excel and extract certain data to put together with file name
Replies
1
Views
2K
HeinrichPaul
H
H
  • Solved
Search for topics based on their groups.
Replies
7
Views
140
Peter_SSs
Peter_SSs

Forum statistics

Threads
1,214,878
Messages
6,122,062
Members
449,064
Latest member
scottdog129

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