• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

VBA: Not Looping Correctly

X

xstarx

New Member
Hi,

My VBA is not looping correctly, please help. Thanks


Code: 
Sub UpdateSheetsAAtoABC()
 
Dim ws As Worksheet
Dim ColA As Integer, ColB As Integer
Dim ACell As Range
Dim BCell As Range
 
For Each ws In ActiveWindow.SelectedSheets
        With ws
       
'      Select sheets "AA:ABC"; all countries tab except for Truphatek
'      To save lastest Forecast to compare against actual
 
    On Error Resume Next
    Range("p16:p559").CopyRange ("q16:q559")
      .Range("q16:q559").Value = .Range("p16:p559").Value
     
    Range("ay16:ay559").CopyRange ("az16:az559")
      .Range("az16:az559").Value = .Range("ay16:ay559").Value
 
    Range("bu16:bu559").CopyRange ("bv16:bv559")
      .Range("bv16:bv559").Value = .Range("bu16:bu559").Value
     
 
'      Update formula for Sales & COGS - Euro'000.
'      Copy last month's formula to current month.
'      Copy and paste last month's figures as value.
 
  For Each ACell In .Range("am14:ax14")
  If Mid(Cell, 1, 3) = Mid(ThisWorkbook.Name, 35, 3) Then
                            ColA = Cell.Column
                            ColB = ColA + 1
 
    .Range(.Cells(16, ColB), .Cells(166, ColB)).Formula = .Range(.Cells(16, ColA), .Cells(166, ColA)).Formula
    .Range(.Cells(17, ColA), .Cells(22, ColA)).Value = .Range(.Cells(17, ColA), .Cells(22, ColA)).Value
    .Range(.Cells(24, ColA), .Cells(32, ColA)).Value = .Range(.Cells(24, ColA), .Cells(32, ColA)).Value
    .Range(.Cells(34, ColA), .Cells(45, ColA)).Value = .Range(.Cells(34, ColA), .Cells(45, ColA)).Value
    .Range(.Cells(47, ColA), .Cells(49, ColA)).Value = .Range(.Cells(47, ColA), .Cells(49, ColA)).Value
    .Range(.Cells(51, ColA), .Cells(58, ColA)).Value = .Range(.Cells(51, ColA), .Cells(58, ColA)).Value
    .Range(.Cells(60, ColA), .Cells(70, ColA)).Value = .Range(.Cells(60, ColA), .Cells(70, ColA)).Value
    .Range(.Cells(72, ColA), .Cells(79, ColA)).Value = .Range(.Cells(72, ColA), .Cells(79, ColA)).Value
    .Range(.Cells(81, ColA), .Cells(86, ColA)).Value = .Range(.Cells(81, ColA), .Cells(86, ColA)).Value
    .Range(.Cells(96, ColA), .Cells(101, ColA)).Value = .Range(.Cells(96, ColA), .Cells(101, ColA)).Value
    .Range(.Cells(103, ColA), .Cells(111, ColA)).Value = .Range(.Cells(103, ColA), .Cells(111, ColA)).Value
    .Range(.Cells(113, ColA), .Cells(124, ColA)).Value = .Range(.Cells(113, ColA), .Cells(124, ColA)).Value
    .Range(.Cells(126, ColA), .Cells(128, ColA)).Value = .Range(.Cells(126, ColA), .Cells(128, ColA)).Value
    .Range(.Cells(130, ColA), .Cells(137, ColA)).Value = .Range(.Cells(130, ColA), .Cells(137, ColA)).Value
    .Range(.Cells(139, ColA), .Cells(149, ColA)).Value = .Range(.Cells(139, ColA), .Cells(149, ColA)).Value
    .Range(.Cells(151, ColA), .Cells(158, ColA)).Value = .Range(.Cells(151, ColA), .Cells(158, ColA)).Value
    .Range(.Cells(160, ColA), .Cells(165, ColA)).Value = .Range(.Cells(160, ColA), .Cells(165, ColA)).Value
   
 
'      Update formula for Sales, COGS, Std Margin, Std Margin % - US'000 Actual rate.
'      Copy last month's formula to current month.
 
  For Each BCell In .Range("d14:o14")
  If Mid(Cell, 1, 3) = Mid(ThisWorkbook.Name, 35, 3) Then
                            ColA = Cell.Column
                            ColB = ColA + 1
    .Range(.Cells(16, ColB), .Cells(166, ColB)).Formula = .Range(.Cells(16, ColA), .Cells(166, ColA)).Formula
 
 
End If
 
Next BCell
End If
Next ACell
 
End With
Next ws
 
End Sub
 
Can you explain more ?
Is there any errors appear when executing the code ?
It would be better to upload sample file to find proper help from forum members
 
I have resolved the looping error, however the macro is taking quite some time to finish executing. Any way to let it run faster?

Code: 
Sub UpdateSheetsAAtoABC()
 
Dim ws As Worksheet
Dim ColA As Integer, ColB As Integer
Dim ACell As Range
Dim BCell As Range
 
Application.ScreenUpdating = False
 
For Each ws In ActiveWindow.SelectedSheets
        With ws
       
'      Select sheets "AA:ABC"; all countries tab except for Truphatek
'      To save lastest Forecast to compare against actual
 
    On Error Resume Next
    Range("p16:p559").CopyRange ("q16:q559")
      .Range("q16:q559").Value = .Range("p16:p559").Value
     
    Range("ay16:ay559").CopyRange ("az16:az559")
      .Range("az16:az559").Value = .Range("ay16:ay559").Value
 
    Range("bu16:bu559").CopyRange ("bv16:bv559")
      .Range("bv16:bv559").Value = .Range("bu16:bu559").Value
     
 
'      Update formula for Sales & COGS - Euro'000.
'      Copy last month's formula to current month.
'      Copy and paste last month's figures as value.
 
  For Each ACell In .Range("am14:ax14")
  If Mid(ACell, 1, 3) = Mid(ThisWorkbook.Name, 35, 3) Then
                            ColA = ACell.Column
                            ColB = ColA + 1
 
    .Range(.Cells(16, ColB), .Cells(166, ColB)).Formula = .Range(.Cells(16, ColA), .Cells(166, ColA)).Formula
    .Range(.Cells(17, ColA), .Cells(22, ColA)).Value = .Range(.Cells(17, ColA), .Cells(22, ColA)).Value
    .Range(.Cells(24, ColA), .Cells(32, ColA)).Value = .Range(.Cells(24, ColA), .Cells(32, ColA)).Value
    .Range(.Cells(34, ColA), .Cells(45, ColA)).Value = .Range(.Cells(34, ColA), .Cells(45, ColA)).Value
    .Range(.Cells(47, ColA), .Cells(49, ColA)).Value = .Range(.Cells(47, ColA), .Cells(49, ColA)).Value
    .Range(.Cells(51, ColA), .Cells(58, ColA)).Value = .Range(.Cells(51, ColA), .Cells(58, ColA)).Value
    .Range(.Cells(60, ColA), .Cells(70, ColA)).Value = .Range(.Cells(60, ColA), .Cells(70, ColA)).Value
    .Range(.Cells(72, ColA), .Cells(79, ColA)).Value = .Range(.Cells(72, ColA), .Cells(79, ColA)).Value
    .Range(.Cells(81, ColA), .Cells(86, ColA)).Value = .Range(.Cells(81, ColA), .Cells(86, ColA)).Value
    .Range(.Cells(96, ColA), .Cells(101, ColA)).Value = .Range(.Cells(96, ColA), .Cells(101, ColA)).Value
    .Range(.Cells(103, ColA), .Cells(111, ColA)).Value = .Range(.Cells(103, ColA), .Cells(111, ColA)).Value
    .Range(.Cells(113, ColA), .Cells(124, ColA)).Value = .Range(.Cells(113, ColA), .Cells(124, ColA)).Value
    .Range(.Cells(126, ColA), .Cells(128, ColA)).Value = .Range(.Cells(126, ColA), .Cells(128, ColA)).Value
    .Range(.Cells(130, ColA), .Cells(137, ColA)).Value = .Range(.Cells(130, ColA), .Cells(137, ColA)).Value
    .Range(.Cells(139, ColA), .Cells(149, ColA)).Value = .Range(.Cells(139, ColA), .Cells(149, ColA)).Value
    .Range(.Cells(151, ColA), .Cells(158, ColA)).Value = .Range(.Cells(151, ColA), .Cells(158, ColA)).Value
    .Range(.Cells(160, ColA), .Cells(165, ColA)).Value = .Range(.Cells(160, ColA), .Cells(165, ColA)).Value
   
 
'      Update formula for Sales, COGS, Std Margin, Std Margin % - US'000 Actual rate.
'      Copy last month's formula to current month.
 
  For Each BCell In .Range("d14:o14")
  If Mid(BCell, 1, 3) = Mid(ThisWorkbook.Name, 35, 3) Then
                            ColA = BCell.Column
                            ColB = ColA + 1
    .Range(.Cells(16, ColB), .Cells(559, ColB)).Formula = .Range(.Cells(16, ColA), .Cells(559, ColA)).Formula
 
Application.ScreenUpdating = True
 
End If
 
Next BCell
End If
Next ACell
 
End With
Next ws
 
  MsgBox "Macro has finished updating"
 
End Sub
 
You must log in or register to reply here.
Back
Top