VBA - Loop through Columns

M

MartinL

Well-known Member
Joined
Oct 16, 2008
Messages
1,141
Office Version
  1. 365
Platform
  1. Windows
I have a data set that I need to reorganise

Currently the data runs across the columns as:
COL A:C = Descriptions
ROW 1:1 = Week End dates
ROW 2:2 = Week Number
and D3:BC122 = Values

AccData

<TABLE style="BACKGROUND-COLOR: #ffffff; PADDING-LEFT: 2pt; PADDING-RIGHT: 2pt; FONT-FAMILY: Calibri,Arial; FONT-SIZE: 11pt" border=1 cellSpacing=0 cellPadding=0><COLGROUP><COL style="WIDTH: 30px; FONT-WEIGHT: bold"><COL style="WIDTH: 86px"><COL style="WIDTH: 187px"><COL style="WIDTH: 161px"><COL style="WIDTH: 71px"><COL style="WIDTH: 71px"><COL style="WIDTH: 70px"><COL style="WIDTH: 70px"><COL style="WIDTH: 63px"></COLGROUP><TBODY><TR style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt; FONT-WEIGHT: bold"><TD> </TD><TD>A</TD><TD>B</TD><TD>C</TD><TD>D</TD><TD>E</TD><TD>F</TD><TD>G</TD><TD>H</TD></TR><TR style="HEIGHT: 15px"><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt">1</TD><TD style="FONT-FAMILY: Arial; FONT-SIZE: 10pt"> </TD><TD style="FONT-FAMILY: Arial; FONT-SIZE: 10pt"> </TD><TD style="FONT-FAMILY: Arial; FONT-SIZE: 10pt"> </TD><TD style="TEXT-ALIGN: right; FONT-FAMILY: Arial; FONT-SIZE: 10pt">09/01/2010</TD><TD style="TEXT-ALIGN: right; FONT-FAMILY: Arial; FONT-SIZE: 10pt">16/01/2010</TD><TD style="TEXT-ALIGN: right; FONT-FAMILY: Arial; FONT-SIZE: 10pt">23/01/2010</TD><TD style="TEXT-ALIGN: right; FONT-FAMILY: Arial; FONT-SIZE: 10pt">30/01/2010</TD><TD style="TEXT-ALIGN: right; FONT-FAMILY: Arial; FONT-SIZE: 10pt">########</TD></TR><TR style="HEIGHT: 15px"><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt">2</TD><TD style="FONT-FAMILY: Arial; FONT-SIZE: 10pt">Product Code</TD><TD style="FONT-FAMILY: Arial; FONT-SIZE: 10pt">Product Name</TD><TD style="FONT-FAMILY: Arial; FONT-SIZE: 10pt">Group</TD><TD style="FONT-FAMILY: Arial; FONT-SIZE: 10pt">Week 1</TD><TD style="FONT-FAMILY: Arial; FONT-SIZE: 10pt">Week 2</TD><TD style="FONT-FAMILY: Arial; FONT-SIZE: 10pt">Week 3</TD><TD style="FONT-FAMILY: Arial; FONT-SIZE: 10pt">Week 4</TD><TD style="FONT-FAMILY: Arial; FONT-SIZE: 10pt">Week 5</TD></TR><TR style="HEIGHT: 15px"><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt">3</TD><TD style="TEXT-ALIGN: right; FONT-FAMILY: Arial; FONT-SIZE: 10pt">4311</TD><TD style="FONT-FAMILY: Arial; FONT-SIZE: 10pt">Baby Courgettes 200g</TD><TD style="FONT-FAMILY: Arial; FONT-SIZE: 10pt">Baby Veg</TD><TD style="TEXT-ALIGN: right; FONT-FAMILY: Arial; FONT-SIZE: 10pt">5138.1</TD><TD style="TEXT-ALIGN: right; FONT-FAMILY: Arial; FONT-SIZE: 10pt">623.7</TD><TD style="TEXT-ALIGN: right; FONT-FAMILY: Arial; FONT-SIZE: 10pt">0</TD><TD style="TEXT-ALIGN: right; FONT-FAMILY: Arial; FONT-SIZE: 10pt">732.6</TD><TD style="TEXT-ALIGN: right; FONT-FAMILY: Arial; FONT-SIZE: 10pt">5949.9</TD></TR><TR style="HEIGHT: 15px"><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt">4</TD><TD style="TEXT-ALIGN: right; FONT-FAMILY: Arial; FONT-SIZE: 10pt">4621</TD><TD style="FONT-FAMILY: Arial; FONT-SIZE: 10pt">Chillies Finger 100g</TD><TD style="FONT-FAMILY: Arial; FONT-SIZE: 10pt">Chillies</TD><TD style="TEXT-ALIGN: right; FONT-FAMILY: Arial; FONT-SIZE: 10pt">16634.16</TD><TD style="TEXT-ALIGN: right; FONT-FAMILY: Arial; FONT-SIZE: 10pt">14700.24</TD><TD style="TEXT-ALIGN: right; FONT-FAMILY: Arial; FONT-SIZE: 10pt">0</TD><TD style="TEXT-ALIGN: right; FONT-FAMILY: Arial; FONT-SIZE: 10pt">0</TD><TD style="TEXT-ALIGN: right; FONT-FAMILY: Arial; FONT-SIZE: 10pt">0</TD></TR><TR style="HEIGHT: 15px"><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt">5</TD><TD style="TEXT-ALIGN: right; FONT-FAMILY: Arial; FONT-SIZE: 10pt">4631</TD><TD style="FONT-FAMILY: Arial; FONT-SIZE: 10pt">Chillies Birdseye 20g</TD><TD style="FONT-FAMILY: Arial; FONT-SIZE: 10pt">Chillies</TD><TD style="TEXT-ALIGN: right; FONT-FAMILY: Arial; FONT-SIZE: 10pt">5377.05</TD><TD style="TEXT-ALIGN: right; FONT-FAMILY: Arial; FONT-SIZE: 10pt">4407.48</TD><TD style="TEXT-ALIGN: right; FONT-FAMILY: Arial; FONT-SIZE: 10pt">4329.99</TD><TD style="TEXT-ALIGN: right; FONT-FAMILY: Arial; FONT-SIZE: 10pt">4131.54</TD><TD style="TEXT-ALIGN: right; FONT-FAMILY: Arial; FONT-SIZE: 10pt">4180.68</TD></TR><TR style="HEIGHT: 15px"><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt">6</TD><TD style="TEXT-ALIGN: right; FONT-FAMILY: Arial; FONT-SIZE: 10pt">4561</TD><TD style="FONT-FAMILY: Arial; FONT-SIZE: 10pt">Chillies Red 50g</TD><TD style="FONT-FAMILY: Arial; FONT-SIZE: 10pt">Chillies</TD><TD style="TEXT-ALIGN: right; FONT-FAMILY: Arial; FONT-SIZE: 10pt">23980.32</TD><TD style="TEXT-ALIGN: right; FONT-FAMILY: Arial; FONT-SIZE: 10pt">21576.24</TD><TD style="TEXT-ALIGN: right; FONT-FAMILY: Arial; FONT-SIZE: 10pt">21137.76</TD><TD style="TEXT-ALIGN: right; FONT-FAMILY: Arial; FONT-SIZE: 10pt">20113.38</TD><TD style="TEXT-ALIGN: right; FONT-FAMILY: Arial; FONT-SIZE: 10pt">18204.48</TD></TR><TR style="HEIGHT: 15px"><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt">7</TD><TD style="TEXT-ALIGN: right; FONT-FAMILY: Arial; FONT-SIZE: 10pt">4611</TD><TD style="FONT-FAMILY: Arial; FONT-SIZE: 10pt">Chillies Scotch Bon 30</TD><TD style="FONT-FAMILY: Arial; FONT-SIZE: 10pt">Chillies</TD><TD style="TEXT-ALIGN: right; FONT-FAMILY: Arial; FONT-SIZE: 10pt">1567.8</TD><TD style="TEXT-ALIGN: right; FONT-FAMILY: Arial; FONT-SIZE: 10pt">2461.68</TD><TD style="TEXT-ALIGN: right; FONT-FAMILY: Arial; FONT-SIZE: 10pt">2417.22</TD><TD style="TEXT-ALIGN: right; FONT-FAMILY: Arial; FONT-SIZE: 10pt">2370.42</TD><TD style="TEXT-ALIGN: right; FONT-FAMILY: Arial; FONT-SIZE: 10pt">2328.3</TD></TR><TR style="HEIGHT: 15px"><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt">8</TD><TD style="TEXT-ALIGN: right; FONT-FAMILY: Arial; FONT-SIZE: 10pt">4426</TD><TD style="FONT-FAMILY: Arial; FONT-SIZE: 10pt">Asp Bundles 450g</TD><TD style="FONT-FAMILY: Arial; FONT-SIZE: 10pt">Asparagus</TD><TD style="TEXT-ALIGN: right; FONT-FAMILY: Arial; FONT-SIZE: 10pt">25760.16</TD><TD style="TEXT-ALIGN: right; FONT-FAMILY: Arial; FONT-SIZE: 10pt">29761.6</TD><TD style="TEXT-ALIGN: right; FONT-FAMILY: Arial; FONT-SIZE: 10pt">39345.12</TD><TD style="TEXT-ALIGN: right; FONT-FAMILY: Arial; FONT-SIZE: 10pt">36958.24</TD><TD style="TEXT-ALIGN: right; FONT-FAMILY: Arial; FONT-SIZE: 10pt">18578.72</TD></TR><TR style="HEIGHT: 15px"><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt">9</TD><TD style="TEXT-ALIGN: right; FONT-FAMILY: Arial; FONT-SIZE: 10pt">4590</TD><TD style="FONT-FAMILY: Arial; FONT-SIZE: 10pt">ASP Loose 3Kg</TD><TD style="FONT-FAMILY: Arial; FONT-SIZE: 10pt">Asparagus</TD><TD style="TEXT-ALIGN: right; FONT-FAMILY: Arial; FONT-SIZE: 10pt">0</TD><TD style="TEXT-ALIGN: right; FONT-FAMILY: Arial; FONT-SIZE: 10pt">0</TD><TD style="TEXT-ALIGN: right; FONT-FAMILY: Arial; FONT-SIZE: 10pt">0</TD><TD style="TEXT-ALIGN: right; FONT-FAMILY: Arial; FONT-SIZE: 10pt">0</TD><TD style="TEXT-ALIGN: right; FONT-FAMILY: Arial; FONT-SIZE: 10pt">0</TD></TR><TR style="HEIGHT: 15px"><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt">10</TD><TD style="TEXT-ALIGN: right; FONT-FAMILY: Arial; FONT-SIZE: 10pt">4053</TD><TD style="FONT-FAMILY: Arial; FONT-SIZE: 10pt">Fine Beans 200g</TD><TD style="FONT-FAMILY: Arial; FONT-SIZE: 10pt">Fine Beans</TD><TD style="TEXT-ALIGN: right; FONT-FAMILY: Arial; FONT-SIZE: 10pt">9822.9</TD><TD style="TEXT-ALIGN: right; FONT-FAMILY: Arial; FONT-SIZE: 10pt">10302.4</TD><TD style="TEXT-ALIGN: right; FONT-FAMILY: Arial; FONT-SIZE: 10pt">9973.6</TD><TD style="TEXT-ALIGN: right; FONT-FAMILY: Arial; FONT-SIZE: 10pt">10343.5</TD><TD style="TEXT-ALIGN: right; FONT-FAMILY: Arial; FONT-SIZE: 10pt">10151.7</TD></TR><TR style="HEIGHT: 15px"><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt">11</TD><TD style="TEXT-ALIGN: right; FONT-FAMILY: Arial; FONT-SIZE: 10pt">4810</TD><TD style="FONT-FAMILY: Arial; FONT-SIZE: 10pt">Green Beans Loose 5Kg</TD><TD style="FONT-FAMILY: Arial; FONT-SIZE: 10pt">Dwarf Beans</TD><TD style="TEXT-ALIGN: right; FONT-FAMILY: Arial; FONT-SIZE: 10pt">7825</TD><TD style="TEXT-ALIGN: right; FONT-FAMILY: Arial; FONT-SIZE: 10pt">7112.5</TD><TD style="TEXT-ALIGN: right; FONT-FAMILY: Arial; FONT-SIZE: 10pt">7325</TD><TD style="TEXT-ALIGN: right; FONT-FAMILY: Arial; FONT-SIZE: 10pt">7475</TD><TD style="TEXT-ALIGN: right; FONT-FAMILY: Arial; FONT-SIZE: 10pt">8225</TD></TR><TR style="HEIGHT: 15px"><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt">12</TD><TD style="TEXT-ALIGN: right; FONT-FAMILY: Arial; FONT-SIZE: 10pt">4571</TD><TD style="FONT-FAMILY: Arial; FONT-SIZE: 10pt">Chillies Mixed 56g</TD><TD style="FONT-FAMILY: Arial; FONT-SIZE: 10pt">Chillies</TD><TD style="TEXT-ALIGN: right; FONT-FAMILY: Arial; FONT-SIZE: 10pt">20166.3</TD><TD style="TEXT-ALIGN: right; FONT-FAMILY: Arial; FONT-SIZE: 10pt">18370.8</TD><TD style="TEXT-ALIGN: right; FONT-FAMILY: Arial; FONT-SIZE: 10pt">17758.44</TD><TD style="TEXT-ALIGN: right; FONT-FAMILY: Arial; FONT-SIZE: 10pt">18068.4</TD><TD style="TEXT-ALIGN: right; FONT-FAMILY: Arial; FONT-SIZE: 10pt">19724.04</TD></TR></TBODY></TABLE>

Excel tables to the web >> http://www.excel-jeanie-html.de/index.php?f=1" target="_blank"> Excel Jeanie HTML 4



What I need to do is create some VBA that will loop through E:BC moving the data in the column to under the data in Col C each time (and also A:C)

I can create loops that add 1 to row number but am stuck adding 1 to column in VBA.

Unless someone knows an easier way of doing this....

Martin
 
Last edited:

Excel Facts

Is there a shortcut key for strikethrough?
Ctrl+S is used for Save. Ctrl+5 is used for Strikethrough. Why Ctrl+5? When you use hashmarks to count |||| is 4, strike through to mean 5.
Sort by date Sort by votes
MartinL said:
I can create loops that add 1 to row number but am stuck adding 1 to column in VBA
Click to expand...
Hi Martin,

I don't get exactly what you need to do, but If you want to handle each column with a variable, an easy
way would be as the following macro I've written, that coloring each even column. The current column is
controlled by "i" For Loop variable.
Code: 
[COLOR=Navy]Sub [/COLOR]Coloring_Even_Columns()

LastCol = Cells.Find(What:="*", After:=[A1], SearchOrder:=xlByColumns, _
          SearchDirection:=xlPrevious).Column

For i = 1 To LastCol
    
  If i Mod 2 = 0 Then  [COLOR=Green]'Evaluates if "i" is an even number (Mod=0[/COLOR])

   Columns(i).Interior.Color = 5296274 [COLOR=Green]'coloring in green current column[/COLOR]
[COLOR=Blue]         'Here you can add 1 to each column as you need, something like [/COLOR]
[COLOR=Blue]        'Columns(i+1)[/COLOR].Int.....
  End If
Next
[COLOR=Navy]End Sub[/COLOR]
Excel Workbook
ABCDEFGH
109/01/201016/01/201023/01/201030/01/2010########
2Product CodeProduct NameGroupWeek 1Week 2Week 3Week 4Week 5
34311Baby Courgettes 200gBaby Veg5138.1623.70732.65949.9
44621Chillies Finger 100gChillies16634.1614700.24000
54631Chillies Birdseye 20gChillies5377.054407.484329.994131.544180.68
64561Chillies Red 50gChillies23980.3221576.2421137.7620113.3818204.48
74611Chillies Scotch Bon 30Chillies1567.82461.682417.222370.422328.3
84426Asp Bundles 450gAsparagus25760.1629761.639345.1236958.2418578.72
94590ASP Loose 3KgAsparagus00000
104053Fine Beans 200gFine Beans9822.910302.49973.610343.510151.7
114810Green Beans Loose 5KgDwarf Beans78257112.5732574758225
124571Chillies Mixed 56gChillies20166.318370.817758.4418068.419724.04
Hoja2
Excel 2010


Hope this helps,

Regards.
 
Last edited:
Upvote 0
Hi César C

What I am trying to achieve is below.

Excel Workbook
ABCDE
15Product CodeProduct NameGroupw.e.DateValue
164311Baby Courgettes 200gBaby Veg09/01/20105138.1
174621Chillies Finger 100gChillies09/01/201016634.16
184631Chillies Birdseye 20gChillies09/01/20105377.05
194561Chillies Red 50gChillies09/01/201023980.32
204611Chillies Scotch Bon 30Chillies09/01/20101567.8
214426Asp Bundles 450gAsparagus09/01/201025760.16
224590ASP Loose 3KgAsparagus09/01/20100
234053Fine Beans 200gFine Beans09/01/20109822.9
244810Green Beans Loose 5KgDwarf Beans09/01/20107825
254571Chillies Mixed 56gChillies09/01/201020166.3
264311Baby Courgettes 200gBaby Veg16/01/2010623.7
274621Chillies Finger 100gChillies16/01/201014700.24
284631Chillies Birdseye 20gChillies16/01/20104407.48
294561Chillies Red 50gChillies16/01/201021576.24
304611Chillies Scotch Bon 30Chillies16/01/20102461.68
314426Asp Bundles 450gAsparagus16/01/201029761.6
324590ASP Loose 3KgAsparagus16/01/20100
334053Fine Beans 200gFine Beans16/01/201010302.4
344810Green Beans Loose 5KgDwarf Beans16/01/20107112.5
354571Chillies Mixed 56gChillies16/01/201018370.8
364311Baby Courgettes 200gBaby Veg23/01/20100
374621Chillies Finger 100gChillies23/01/20100
384631Chillies Birdseye 20gChillies23/01/20104329.99
394561Chillies Red 50gChillies23/01/201021137.76
404611Chillies Scotch Bon 30Chillies23/01/20102417.22
414426Asp Bundles 450gAsparagus23/01/201039345.12
424590ASP Loose 3KgAsparagus23/01/20100
434053Fine Beans 200gFine Beans23/01/20109973.6
444810Green Beans Loose 5KgDwarf Beans23/01/20107325
454571Chillies Mixed 56gChillies23/01/201017758.44
464311Baby Courgettes 200gBaby Veg30/01/2010732.6
474621Chillies Finger 100gChillies30/01/20100
484631Chillies Birdseye 20gChillies30/01/20104131.54
494561Chillies Red 50gChillies30/01/201020113.38
504611Chillies Scotch Bon 30Chillies30/01/20102370.42
514426Asp Bundles 450gAsparagus30/01/201036958.24
524590ASP Loose 3KgAsparagus30/01/20100
534053Fine Beans 200gFine Beans30/01/201010343.5
544810Green Beans Loose 5KgDwarf Beans30/01/20107475
554571Chillies Mixed 56gChillies30/01/201018068.4
564311Baby Courgettes 200gBaby Veg06/02/20105949.9
574621Chillies Finger 100gChillies06/02/20100
584631Chillies Birdseye 20gChillies06/02/20104180.68
594561Chillies Red 50gChillies06/02/201018204.48
604611Chillies Scotch Bon 30Chillies06/02/20102328.3
614426Asp Bundles 450gAsparagus06/02/201018578.72
624590ASP Loose 3KgAsparagus06/02/20100
634053Fine Beans 200gFine Beans06/02/201010151.7
644810Green Beans Loose 5KgDwarf Beans06/02/20108225
654571Chillies Mixed 56gChillies06/02/201019724.04
Sheet2



Regards

Martin
 
Upvote 0
OK

This appears to be going wrong when I try to update my variables with the Column/Row contents:

Can anyone see why...
Period = Range(Columns(i) & Rows(d))
PVal = Range(Columns(i) & Rows(A))

Rich (BB code): 
Sub GetAccountsData()
'*****************************************************************************
'*****************************************************************************
 
 
Dim TestForUPC As Range
Dim TestFori As Range
Dim Sht As Worksheet
Dim Lastrow1 As Long
Dim Lastrow2 As Long
Dim A As Long               'Row number Accounts
Dim B As Long               'Row number Data
Dim i As Long               'Column Counter Accounts
Dim d As Long               'Date Row Accounts
Dim w As Long               'Week Row Accounts
Dim Period As Long          'Date
Dim WeekNo As Long          'Week Number
Dim PVal As Long            '£ Value
Dim PDesc As String         'Prod Name
Dim PGrp As String          'Prod Group
Dim PUPC As Long            'Prod UPC
Dim Ret As String
 
Application.EnableEvents = False
Application.ScreenUpdating = False
Application.DisplayAlerts = False
'Set wbThis = ThisWorkbook
A = 1
d = 1
w = 2
'Set start of paste range
Sheets("Data").Select
With ActiveSheet
  Lastrow1 = .Cells(Rows.Count, "A").End(xlUp).Row
End With
'Find the last row
B = Lastrow1 + 1
Range("A" & B).Select
'Find the last Column
Lastcol = Cells.Find(What:="*", After:=[A1], SearchOrder:=xlByColumns, _
        SearchDirection:=xlPrevious).Column
i = 4
Sheets("Accounts").Select
'Period = Range("AJ2")
'SCat = Range("B4")
'Cat = Range("C4")
Ret = "Ret1"
On Error Resume Next
'calculate last row of Accounts
With ActiveSheet
  Lastrow2 = .Cells(Rows.Count, "A").End(xlUp).Row
End With
'Get Stock
With ActiveSheet
  Set TestForUPC = .Range("A1:A" & Lastrow2 + 1)
  Set TestForLD = .Range("D" & A & ":" & Lastcol & Lastrow2)
End With
Range("A" & A).Select
 
For Each LD In TestForLD.Cells
For Each UPC In TestForUPC.Cells
 
'If IsNumeric(UPC) Then
If UPC > 0 Then
  PUPC = Range("A" & A)
  PDesc = Range("B" & A)
  PGrp = Range("AJ" & A)
 
'These 2 lines produce nothing??
  Period = Range(Columns(i) & Rows(d))
  PVal = Range(Columns(i) & Rows(A))
 
  'ActiveWindow.ActivatePrevious
  Sheets("Data").Select
 
  Range("A" & B) = Ret
  Range("B" & B) = PUPC
  Range("C" & B) = PDesc
  Range("D" & B) = PGrp
  Range("F" & B) = PVal
 
  B = B + 1
End If
  'ActiveWindow.ActivatePrevious
  Sheets("Accounts").Select
ignore:
A = A + 1
Next UPC
i = i + 1
Next LD
Sheets("DATA").Select
Application.EnableEvents = True
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
 
Upvote 0
Hi Martin,

To assign the value of that range to a variable try as this example:
Code: 
Sub test()

i = 2
d = 1
A = 1

ColAddress = Cells(1, i).Address
Col = Left(ColAddress, InStrRev(ColAddress, "$") - 1)

 [COLOR=Red] Period = Range(Col & d)
  PVal = Range(Col & A)[/COLOR]
End Sub
 
Upvote 0
Hi César

It most certainly does help and whats more I can work out what you have done.

Thanks you :beerchug:

for completeness here is my (our) code, no doubt some smarty pants will find a way of doing it in half as many lines but thats the wonder of VBA

Rich (BB code): 
Sub GetAccountsData()
Rich (BB code): 
'*****************************************************************************
'*****************************************************************************
 
 
Dim TestForUPC As Range
Dim TestFori As Range
Dim Lastrow1 As Long
Dim Lastrow2 As Long
Dim a As Long               'Row number Accounts
Dim b As Long               'Row number Data
Dim i As Long               'Column Counter Accounts
Dim d As Long               'Date Row Accounts
Dim w As Long               'Week Row Accounts
Dim Period As Long          'Date
Dim WeekNo As String        'Week Number
Dim PVal As Long            '£ Value
Dim PDesc As String         'Prod Name
Dim PGrp As String          'Prod Group
Dim PUPC As Long            'Prod UPC
Dim Ret As String
 
Application.EnableEvents = False
Application.ScreenUpdating = False
Application.DisplayAlerts = False
'Set wbThis = ThisWorkbook
a = 11
d = 1
w = 2
'Set start of paste range
Sheets("Data").Select
With ActiveSheet
 Lastrow1 = .Cells(Rows.Count, "A").End(xlUp).Row
End With
'Find the last row
b = Lastrow1 + 1
Range("A" & b).Select
Sheets("Accounts").Select
Ret = Range("G7")
i = 8
'Find the last Column
Lastcol = Cells.Find(What:="*", After:=[A1], SearchOrder:=xlByColumns, _
       SearchDirection:=xlPrevious).Column
On Error Resume Next
'calculate last row of Accounts
With ActiveSheet
 Lastrow2 = .Cells(Rows.Count, "A").End(xlUp).Row
End With
'Get Stock
With ActiveSheet
 Set TestForUPC = .Range("B11:B" & Lastrow2 + 1)
 Set TestForLD = .Range("H" & a & ":" & Lastcol & Lastrow2)
End With
Range("B" & a).Select
 
For Each LD In TestForLD.Cells
Nextcol:
 ColAddress = Cells(1, i).Address
 Col = Left(ColAddress, InStrRev(ColAddress, "$") - 1)
For Each UPC In TestForUPC.Cells
'If IsNumeric(UPC) Then
If UPC > 0 And Range(Col & a) > 0 Then
 PUPC = Range("B" & a)
 PDesc = Range("D" & a)
 PGrp = Range("G" & a)
 WeekNo = Range(Col & 2)
 Period = Range(Col & 1)
 PVal = Range(Col & a)
 
 'ActiveWindow.ActivatePrevious
 Sheets("Data").Select
 
 Range("A" & b) = Ret
 Range("B" & b) = PUPC
 Range("C" & b) = PDesc
 Range("D" & b) = PGrp
 Range("E" & b) = WeekNo
 Range("G" & b) = PVal
 
 b = b + 1
End If
 'ActiveWindow.ActivatePrevious
 Sheets("Accounts").Select
ignore:
a = a + 1
Next UPC
If i < Lastcol Then
 i = i + 1
 a = 3
 GoTo Nextcol
End If
 
Next LD
 
Sheets("DATA").Select
Application.EnableEvents = True
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
 
Last edited:
Upvote 0
MartinL said:
Hi César

It most certainly does help and whats more I can work out what you have done.
Thanks you :beerchug:
for completeness here is my (our) code, no doubt some smarty pants will find a way of doing it in half as
many lines but thats the wonder of VBA
Click to expand...
Hi Martin,

You're welcome!

Nice to know you've get your code with your own algorithm. Certainly some expert somewhere could write
some shorter code, but is great when we achieve our goal with much effort. ;-)
 
Upvote 0
MartinL said:
Hi César

It most certainly does help and whats more I can work out what you have done.

Thanks you :beerchug:

for completeness here is my (our) code, no doubt some smarty pants will find a way of doing it in half as many lines but thats the wonder of VBA

Rich (BB code): 
Sub GetAccountsData()
Rich (BB code): 
'*****************************************************************************
'*****************************************************************************
 
 
Dim TestForUPC As Range
Dim TestFori As Range
Dim Lastrow1 As Long
Dim Lastrow2 As Long
Dim a As Long               'Row number Accounts
Dim b As Long               'Row number Data
Dim i As Long               'Column Counter Accounts
Dim d As Long               'Date Row Accounts
Dim w As Long               'Week Row Accounts
Dim Period As Long          'Date
Dim WeekNo As String        'Week Number
Dim PVal As Long            '£ Value
Dim PDesc As String         'Prod Name
Dim PGrp As String          'Prod Group
Dim PUPC As Long            'Prod UPC
Dim Ret As String
 
Application.EnableEvents = False
Application.ScreenUpdating = False
Application.DisplayAlerts = False
'Set wbThis = ThisWorkbook
a = 11
d = 1
w = 2
'Set start of paste range
Sheets("Data").Select
With ActiveSheet
 Lastrow1 = .Cells(Rows.Count, "A").End(xlUp).Row
End With
'Find the last row
b = Lastrow1 + 1
Range("A" & b).Select
Sheets("Accounts").Select
Ret = Range("G7")
i = 8
'Find the last Column
Lastcol = Cells.Find(What:="*", After:=[A1], SearchOrder:=xlByColumns, _
       SearchDirection:=xlPrevious).Column
On Error Resume Next
'calculate last row of Accounts
With ActiveSheet
 Lastrow2 = .Cells(Rows.Count, "A").End(xlUp).Row
End With
'Get Stock
With ActiveSheet
 Set TestForUPC = .Range("B11:B" & Lastrow2 + 1)
 Set TestForLD = .Range("H" & a & ":" & Lastcol & Lastrow2)
End With
Range("B" & a).Select
 
For Each LD In TestForLD.Cells
Nextcol:
 ColAddress = Cells(1, i).Address
 Col = Left(ColAddress, InStrRev(ColAddress, "$") - 1)
For Each UPC In TestForUPC.Cells
'If IsNumeric(UPC) Then
If UPC > 0 And Range(Col & a) > 0 Then
 PUPC = Range("B" & a)
 PDesc = Range("D" & a)
 PGrp = Range("G" & a)
 WeekNo = Range(Col & 2)
 Period = Range(Col & 1)
 PVal = Range(Col & a)
 
 'ActiveWindow.ActivatePrevious
 Sheets("Data").Select
 
 Range("A" & b) = Ret
 Range("B" & b) = PUPC
 Range("C" & b) = PDesc
 Range("D" & b) = PGrp
 Range("E" & b) = WeekNo
 Range("G" & b) = PVal
 
 b = b + 1
End If
 'ActiveWindow.ActivatePrevious
 Sheets("Accounts").Select
ignore:
a = a + 1
Next UPC
If i < Lastcol Then
 i = i + 1
 a = 3
 GoTo Nextcol
End If
 
Next LD
 
Sheets("DATA").Select
Application.EnableEvents = True
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
Click to expand...

I have a similar issue with reorganizing my data. Your code is very helpful but I am having trouble trying to follow your variables. Could you share your initial table? The screen shots doesn't include UPC or why you would declare "a" as 11. If feels like I am missing something trying to re-create to apply to my situation. Your code is something that I have desperately trying to re-create.

Thanks!
 
Upvote 0
You must log in or register to reply here.

Similar threads

E
  • Question Question
VBA code clean up
Replies
9
Views
582
mumps
mumps
D
  • Solved
VBA Function to Paste Table into Outlook Email Resulting in HTML language in Email
Replies
8
Views
622
smozgur
smozgur
E
  • Question Question
Adding a custom message.
Replies
1
Views
666
Micron
M
G
  • Question Question
Using Excel formula to create HTML code text referencing specific cells
Replies
0
Views
1K
gvsumich
G
A
  • Question Question
VBA - Automatically Break the Line in HTML format.
Replies
7
Views
2K
Attrazion
A

Forum statistics

Threads
1,224,586
Messages
6,179,723
Members
452,939
Latest member
WCrawford

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