For each xcell in xRange.Cell

[mos]

Hi,

I got sheets which calculate numbers for a certain input (yellow field) on the sheet.

sheet "disitri1":

To make a summary I need to input these values into the sheet and then copy a value of a resulting cell (F52) to the summary.
(Reason: each distri1, distri2, etc includes very individual data so is very hard to combine in one sheet, and number of distri will increase)
summary sheet:

This should be done on a certain range, even though there might exist no values.

Private Sub Worksheet_Change(ByVal Target As Range)

Dim xarea             As Range
Dim xCol              As Long
Dim xRow              As Long
Dim xcell             As Object
Dim distributor       As String
Dim quarter           As String
Dim valuetocopy       As Integer
Dim usedsheet         As String

usedsheet = ActiveSheet.Name
Set xarea = Sheets(usedsheet).Range("F6:H17")

For Each xcell In xarea.Cells
      
      xCol = xcell.Column
      xRow = xcell.Row
      distributor = Cells(3, xCol).Value
      quarter = Cells(xRow, 1).Value
            
      Sheets(distributor).Select
      Range("C15:D15").Value = quarter
      
      valuetocopy = Range("F52").Value
      Sheets(usedsheet).Select
      xcell.Value = valuetocopy
      
Next
End Sub

I get an infinite loop. Does "For Each" not work? The line where the debugger stops is
"Sheets(distributor).Select"



I just get into VBA again, maybe you can shortly comment on my code.

Thank you.

mos


P.S. I use Windows XP and Excel
PPS I could not declare Dim xCell A Cell, any idea why?

 

[dk]

Hi there

You are getting an infinite loop because when this line runs it calls the Worksheet_Change event again, and then it changes the xcell.value again, which calls the Worksheet_Change and so on....

xcell.Value = valuetocopy

You can temporarily turn off events by using this code:

        Application.EnableEvents = False
        xcell.Value = valuetocopy
        Application.EnableEvents = True

Also you need to declare xCell as a Range object - there is no Cell object

Finally, you do not need to Select sheets in order to change the values as you can do things like this:

Sheets("Sheet1").Range("A1:B5").Value=Sheets("Sheet2").Range("A1:B5").Value

HTH
DK

 

[mos]

Hi,

thanks a lot!

That's the final code.

Private Sub Worksheet_Change(ByVal Target As Range)

Dim xarea             As Range
Dim xCol              As Long
Dim xRow              As Long
Dim xcell             As Range
Dim distributor       As String
Dim quarter           As Date
Dim valuetocopy       As Integer
Dim usedsheet         As String


Set xarea = Sheets("Summary").Range("F4:I17")

For Each xcell In xarea.Cells
      
      xCol = xcell.Column
      xRow = xcell.Row
      distributor = Cells(3, xCol).Value
      quarter = CDate(Cells(xRow, 1).Value)
            
      Sheets(distributor).Range("C15:D15").Value = quarter
      Sheets(distributor).Range("A1:H75").Calculate
      Application.EnableEvents = False
      xcell.Value = Sheets(distributor).Range("F52").Value
      Calculate
      Application.EnableEvents = True
      
Next
End Sub

hope posting solutions is common here.

cheers