Looping through rows and then by columns

Taul · May 7, 2018

Hi,
I could do with some assistance please. I have data laid out as follows:-
Headers in row 5 and Data in columns A to T (approx. 300 rows of data)
Column A will always shave data in it, so I’m using that column to reference the “lastrow”
Columns G to K will have company names (with some blank) and I need to loop through column G and for each occurrence of data (a company name) I need to paste the company name in the next available row in column F and then repeat for columns H, I J & K
The code I have so far works for the first column but using the offset command pastes the wrong data to column A to E
Can anyone assist in getting a loop within a loop to work correctly please.
I have a feeling it may involve using two variable j & i but I can’t figure that out.

The blue text is not working, so ...
Up to Row 12 is the source data,
Row 13 and below is what is required after the macro is run (should have been blue)

Excel 2010

	A	B	C	D	E	F
Fab 1	Fab 2	Fab 3	Fab 4	Fab 5	Fab 6
R1	GWA	BW	Project 1	Fab 1	Fab 2
R1	GWA	BW	Project 2	Fab 2
R3	MCK	RY	Project 3	Fab 3	Fab 6	Fab 9
R4	AF	CV	Project 4	Fab 2	Fab 3
R4	AF	CV	Project 5	Fab 5	Fab 7	Fab 6
R4	AF	CV	Project 6	Fab 6	Fab 2
R4	AF	CV	Project 7	Fab 7
Row 6	GWA	BW	Project 1	Fab 2
Row 8	MCK	RY	Project 3	Fab 6
Row 9	AF	CV	Project 4	Fab 3
Row 10	AF	CV	Project 5	Fab 7
Row 11	AF	CV	Project 6	Fab 2
Row 8	MCK	RY	Project 3	Fab 9
Row 10	AF	CV	Project 5	Fab 6

After macro runs, the data in BLUE should be pasted

<tbody>
[TD="align: center"]5[/TD]
[TD="bgcolor: #C6E0B4, align: center"]Date[/TD]
[TD="bgcolor: #C6E0B4, align: center"]Module[/TD]
[TD="bgcolor: #C6E0B4, align: center"]Name[/TD]
[TD="bgcolor: #C6E0B4, align: center"]Category[/TD]
[TD="bgcolor: #C6E0B4, align: center"]Project[/TD]

[TD="align: center"]6[/TD]
[TD="align: center"]19-04-18[/TD]

[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]

[TD="align: center"]7[/TD]
[TD="align: center"]24-04-18[/TD]

[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]

[TD="align: center"]8[/TD]
[TD="align: center"]25-04-18[/TD]

[TD="align: center"]9[/TD]
[TD="align: center"]11-04-18[/TD]

[TD="align: center"]10[/TD]
[TD="align: center"]11-04-18[/TD]

[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]

[TD="align: center"]11[/TD]
[TD="align: center"]12-04-18[/TD]

[TD="align: center"]12[/TD]
[TD="align: center"]16-04-18[/TD]

[TD="align: right"][/TD]
[TD="align: right"][/TD]

[TD="align: center"]13[/TD]
[TD="align: center"]19-04-18[/TD]

[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]

[TD="align: center"]14[/TD]
[TD="align: center"]25-04-18[/TD]

[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]

[TD="align: center"]15[/TD]
[TD="align: center"]11-04-18[/TD]

[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]

[TD="align: center"]16[/TD]
[TD="align: center"]11-04-18[/TD]

[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]

[TD="align: center"]17[/TD]
[TD="align: center"]12-04-18[/TD]

[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]

[TD="align: center"]18[/TD]
[TD="align: center"]25-04-18[/TD]

[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]

[TD="align: center"]19[/TD]
[TD="align: center"]11-04-18[/TD]

[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]

[TD="align: center"]20[/TD]
[TD="align: center"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]

[TD="align: center"]21[/TD]

[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]

</tbody>

Sheet1

Code:

Sub AlignFabs()
'Application.ScreenUpdating = False
'Application.Calculation = xlCalculationManual
''**** Loop Through Rows of Fab Names ****
For Each Col In Array("G", "H", "I", "J", "K")
cntr = 0
 
For Each co In Sheet1.Range(Col & "6:" & Col & Sheet1.Range(Col & "65536").End(xlUp).Row + 0)
    lastrow = Sheet1.Range("A65536").End(xlUp).Offset(1, 0).Row 'define the row increment on the Destination sheet
   
    If co.Offset(0, 0).Value <> "" Then
        Sheet1.Range("A" & lastrow).Value = co.Offset(0, -6) 'Date
        Sheet1.Range("B" & lastrow).Value = "Copy" 'ideally paste the row number it came from
        Sheet1.Range("C" & lastrow).Value = co.Offset(0, -4) 'Name
        Sheet1.Range("D" & lastrow).Value = co.Offset(0, -3) 'Category
        Sheet1.Range("E" & lastrow).Value = co.Offset(0, -2) 'Project
        Sheet1.Range("F" & lastrow).Value = co.Offset(0, 0) 'Fab1 column F
    End If
cntr = cntr + 1
Next co
Next Col
'Application.Calculation = xlCalculationAutomatic
'Application.ScreenUpdating = True
End Sub

Fluff · May 11, 2018

How about

Code:

Sub AlignFabs()
Dim cntr As Long
'Application.ScreenUpdating = False
'Application.Calculation = xlCalculationManual
''**** Loop Through Rows of Fab Names ****
cntr = 0

For Each col In Array("G", "H", "I", "J", "K")
 
For Each Co In Sheet6.Range(col & "6:" & col & Sheet6.Range(col & "65536").End(xlUp).Row + 0)
    lastRow = Sheet6.Range("A65536").End(xlUp).Offset(1, 0).Row 'define the row increment on the Destination sheet
   
    If Co.Offset(0, 0).Value <> "" Then
        Sheet6.Range("A" & lastRow).Value = Co.Offset(0, -6 - cntr) 'Date
        Sheet6.Range("B" & lastRow).Value = "Copy" 'ideally paste the row number it came from
        Sheet6.Range("C" & lastRow).Value = Co.Offset(0, -4 - cntr) 'Name
        Sheet6.Range("D" & lastRow).Value = Co.Offset(0, -3) 'Category
        Sheet6.Range("E" & lastRow).Value = Co.Offset(0, -2) 'Project
        Sheet6.Range("F" & lastRow).Value = Co.Offset(0, 0) 'Fab1 column F
    End If
Next Co
cntr = cntr + 1
Next col
'Application.Calculation = xlCalculationAutomatic
'Application.ScreenUpdating = True
End Sub

Taul · May 11, 2018

Thank you Fluff,
I hadn't thought of -cntr, good call.
I will check it out on Monday when I return to work.

Many thanks
Paul

Fluff · May 11, 2018

Do the extra rows need to go at the bottom of the data, or would you be happy with inserting new rows below the existing rows, like

Excel 2013 32 bit

A

B

C

D

E

F

G

H

I

J

K

L

1

5

Date

Module

Name

Category

Project

Fab 1

Fab 2

Fab 3

Fab 4

Fab 5

Fab 6

2

6

19/04/2018

R1

GWA

BW

Project 1

Fab 1

Fab 2

3

7

19/04/2018

R1

GWA

BW

Project 1

Fab 2

4

8

24/04/2018

R1

GWA

BW

Project 2

Fab 2

5

9

25/04/2018

R3

MCK

RY

Project 3

Fab 3

Fab 6

Fab 9

6

10

25/04/2018

R3

MCK

RY

Project 3

Fab 6

7

11

25/04/2018

R3

MCK

RY

Project 3

Fab9

Combined

Fluff · May 11, 2018

If you are interested in the above idea, try

Code:

 Sub TransposeData()
   Dim Cl As Range
   Dim Rws As Long
   Dim i As Long
   
   For i = Range("A" & Rows.Count).End(xlUp).Row To 6 Step -1
      Rws = Application.CountA(Range("G" & i).Resize(, 5))
      If Rws > 0 Then
         Rows(i + 1).Resize(Rws).Insert
         Range("A" & i).Resize(Rws + 1, 5).FillDown
         Range("F" & i + 1).Resize(Rws).Value = Application.Transpose(Range("G" & i).Resize(, Rws))
      End If
   Next i
  [COLOR=#ff0000] Range("G:K").Clear[/COLOR]
 End Sub

Remove the line in red if you want to keep the data in cols G:K

Taul · May 11, 2018

Thank you Fluff,
That's an interesting approach that I hadn't considered.
Just to put more meat on the bones, this whole report is connecting to a shared Outlook Calendar and pulling in all the appointments between specified dates. The Appointment form in Outlook has a custom page with additional drop-downs and text boxes. So the Excel report page (a sample section of it is shown on the original post) also has other formula that are applied at the run time and feed into other pages and graphs on the report, so although your approach is sensible, making the change at this stage would involve making loads of changes to the way the whole report runs. I think your suggestion has now made me realise that I could have laid it out better but I think I will stick to my current approach, if only to avoid the pain of changing it.
But I really appreciate the assistance you have provided.

I may feel different on Monday morning when I run this and with the benefit of a weekend off, I may adopt your approach.

cheers
Paul.

Fluff · May 11, 2018

That's fair enough.
Let me know how it goes.

Looping through rows and then by columns

Taul

Well-known Member

Excel Facts

Fluff

MrExcel MVP, Moderator

Taul

Well-known Member

Fluff

MrExcel MVP, Moderator

Fluff

MrExcel MVP, Moderator

Taul

Well-known Member

Fluff

MrExcel MVP, Moderator

Similar threads

Forum statistics

Share this page

Looping through rows and then by columns

Taul

Well-known Member

Excel Facts

Fluff

MrExcel MVP, Moderator

Taul

Well-known Member

Fluff

MrExcel MVP, Moderator

Fluff

MrExcel MVP, Moderator

Taul

Well-known Member

Fluff

MrExcel MVP, Moderator

Similar threads

Forum statistics

Share this page

We've detected that you are using an adblocker.

Which adblocker are you using?

Disable AdBlock

Disable AdBlock Plus

Disable uBlock Origin

Disable uBlock