Solved: Looping through Columns

[jolivanes]

I am trying to loop through 31 columns (days of the month).
For the first day of the month the macro goes down Column F with
the macro below



Sub TestMacro1()
Application.ScreenUpdating = False
Dim Rng As Range, MyCell As Range
Range("F61:F65").ClearContents
Set Rng = Range("F3:F53")
For Each MyCell In Rng
With MyCell
Select Case True
Case .Value = "H" And .Offset(0, -1).Text = "Small" And .Offset(0, -2).Text = "Medium" And .Offset(0, -3).Text = "Big"
Range("F61").Value = Range("F61").Value + 2
Range("F62").Value = Range("F62").Value + 2
Range("F63").Value = Range("F63").Value + 2
Range("F64").Value = Range("F64").Value + 3
Range("F65").Value = Range("F65").Value + 3
Case .Value = "H" And .Offset(0, -1).Text = "Small" And .Offset(0, -2).Text = "Medium" And .Offset(0, -3).Text = ""
More code
more code
End Select
End With
Next MyCell
'It goes to cell F53
Application.ScreenUpdating = True
End Sub


I could have 31 times the above by changing the column designation letters from F to G and next to H etc and
changing the Offsets by 1 in each subsequent macro. The macro for one day is 65 lines long so
that would be a very long macro and, I am sure a bit over the top. The last column is Column AJ.
How can I loop through the same macro by increasing the column letter by one, and the
offset by 1 so the next loop would be



Range("G61:G65").ClearContents
Set Rng = Range("G3:G53")
For Each MyCell In Rng
With MyCell
Select Case True
Case .Value = "H" And .Offset(0, -2).Text = "Small" And .Offset(0, -3).Text = "Medium" And .Offset(0, -4).Text = "Big"
Range("G61").Value = Range("G61").Value + 2
Range("G62").Value = Range("G62").Value + 2
Range("G63").Value = Range("G63").Value + 2
Range("G64").Value = Range("G64").Value + 3
Range("G65").Value = Range("G65").Value + 3
Case .Value = "H" And .Offset(0, -2).Text = "Small" And .Offset(0, -3).Text = "Medium" And .Offset(0, -4).Text = ""


BTW this a different approach I am trying from the help I received from gwkenney and matthewspatrick at
http://www.vbaexpress.com/forum/showthread.php?t=19804

Thanks and Regards
John

[mikerickson]

This might work for you
Sub TestMacro2()
Application.ScreenUpdating = False
Dim Rng As Range, MyCell As Range

Dim oneColumn As Range
For Each oneColumn In ActiveSheet.Range("F1").Resize(100, 31).Columns
With oneColumn
.Range("a61:a65").ClearContents
Set Rng = .Range("a3:a53")
For Each MyCell In Rng
With MyCell
Select Case True
Case .Value = "H" And .Offset(0, -1).Text = "Small" And .Offset(0, -2).Text = "Medium" And .Offset(0, -3).Text = "Big"
With .EntireColumn
.Range("a61").Value = .Range("a61").Value + 2
.Range("a62").Value = .Range("a62").Value + 2
.Range("a63").Value = .Range("a63").Value + 2
.Range("a64").Value = .Range("a64").Value + 3
.Range("a65").Value = .Range("a65").Value + 3
End With
Case .Value = "H" And .Offset(0, -1).Text = "Small" And .Offset(0, -2).Text = "Medium" And .Offset(0, -3).Text = ""
Rem more code
Rem more code
End Select
End With
Next MyCell
End With
Next oneColumn

'It goes to cell F53
Application.ScreenUpdating = True
End Sub

[Bob Phillips]

Sub TestMacro1()
Dim Rng As Range, MyCell As Range
Dim j As Long

Application.ScreenUpdating = False
For j = 6 To 36

Cells(61, j).Resize(5).ClearContents
Set Rng = Cells(3, j).Resize(51)
For Each MyCell In Rng

With MyCell

Select Case True

Case .Value = "H" And .Offset(0, -(j - 5)).Text = "Small" And _
.Offset(0, -(j - 4)).Text = "Medium" And .Offset(0, -(j - 3)).Text = "Big"

Cells(61, j).Value = Cells(61, j).Value + 2
Cells(62, j).Value = Cells(62, j).Value + 2
Cells(63, j).Value = Cells(63, j).Value + 2
Cells(64, j).Value = Cells(64, j).Value + 3
Cells(65, j).Value = Cells(65, j).Value + 3

Case .Value = "H" And .Offset(0, -(j - 5)).Text = "Small" And _
.Offset(0, -(j - 4)).Text = "Medium" And .Offset(0, -(j - 3)).Text = ""

more code
more code
End Select
End With
Next MyCell
Next j
Application.ScreenUpdating = True
End Sub

[jolivanes]

Mike / Bob.
I have not been able yet to get Mike's solution to work but Bob's works perfect.
Thank you both gentlemen.
Regards.

John