Loop for update

[Volker Hormuth]

Hello,

I have a problem with the processing within a loop. I have found examples
which copy, nevertheless, line-by-line and not cell-wise. Also with Ron de
Bruin I have found nothing, most examples summarise data. Here, therefore, I
ask for help.

My workbook exists of a data sheet and a big number of sheets which show all
same structure. These single sheets (for regions) should be updated from the
data sheet. All values should be simply overwrote.

In column A of the data sheet are the names of the single sheets. These
sheets should be processed with A2 ( A1 header)beginning up to the last
entry. Figure formattings must be preserved. These single sheets already
exist.

The sheets have following structure:
DataSheet
A B C D
E
1 Tablename Area1 Area2 Area3 Area4
2 RegionA 101 201 301 401
3 RegionB 0 202 302 0
4 RegionC 103 0 303 403

RegionSheet
A B C
1 RegionA
2 101
3 201
4
5 301
6 401

I have the following code. The loop by column A is still absent.

Sub RegionUpdaten()
Dim D, F As Worksheet
Dim i%

Set D = Worksheets("Daten")
Set F = Worksheets("RegionA")
i = 2

Do While Not IsEmpty(D.Cells(i, 1))
F.Cells(1, 1) = D.Cells(i, 1)
F.Cells(2, 2) = D.Cells(i, 2)
F.Cells(5, 2) = D.Cells(i, 3)
F.Cells(6, 3) = D.Cells(i, 4)
i = i + 1
Loop
MsgBox "Job Done"
End Sub

Many thanks for every tip.
Volker

 

[Patrick Molloy]

Set D = Worksheets("Daten")

dim rw as long

rw = 2
do until D.cells(rw,"A") =""
Set F = Worksheets( D.cells(rw,"A") )

i = 2


Do While Not IsEmpty(D.Cells(i, 1))
F.Cells(1, 1) = D.Cells(i, 1)
F.Cells(2, 2) = D.Cells(i, 2)
F.Cells(5, 2) = D.Cells(i, 3)
F.Cells(6, 3) = D.Cells(i, 4)
i = i + 1
Loop

rw=rw+1
loop


MsgBox "Job Done"
End Sub

 

[Volker Hormuth]

Set D = Worksheets("Daten")

dim rw as long

rw = 2
do until D.cells(rw,"A") =""
Set F = Worksheets( D.cells(rw,"A") )

i = 2


Do While Not IsEmpty(D.Cells(i, 1))
F.Cells(1, 1) = D.Cells(i, 1)
F.Cells(2, 2) = D.Cells(i, 2)
F.Cells(5, 2) = D.Cells(i, 3)
F.Cells(6, 3) = D.Cells(i, 4)
i = i + 1
Loop

rw=rw+1
loop


MsgBox "Job Done"
End Sub

Hello Patrick,

many thanks for your quick response. As soon as I the programme execute I
get an error message:
Runtime error 13 - types unacceptable - Typen unverträglich
line: Set F = Worksheets(D.Cells(rw, "A"))

What must I change?
Thank you very much!
Volker

 

[Patrick Molloy]

sorry - there's a typo

Set F = Worksheets(D).Cells(rw, "A"))

 

[Volker Hormuth]

Hi Patrick,
again many thanks for your help.
I have replaced the line. Nevertheless, there comes the same error message.
Do you have one more tip?
Volker

 

[Patrick Molloy]

your transpose was incorrect - the code you gave never populated the RegionA
sheet as shown in the first mail. This code corrects that.
How it works
we look at each row of the data table in sheet Daten. starting at row 2, we
move down each row until theres nothing in column A

for each row, we identify the region sheet by the name in column A then put
the 4 values from B,C,D and E into the region sheet, set by the pattern
described.

Option Explicit
Sub RegionUpdaten()
Dim Daten As Worksheet
Dim Region As Worksheet
Dim RegionRow As Range
Dim RegionIndex As Long
'initialise
Set Daten = Worksheets("Daten")
RegionIndex = 2
Do Until Daten.Cells(RegionIndex, 1) = ""

Set RegionRow = Daten.Rows(RegionIndex)
Set Region = Worksheets(RegionRow.Range("A1").Value)
With RegionRow
Region.Cells(1, 1) = .Range("A1")
Region.Cells(2, 2) = .Range("B1")
Region.Cells(3, 2) = .Range("C1")
Region.Cells(5, 2) = .Range("D1")
Region.Cells(6, 3) = .Range("E1")
End With
RegionIndex = RegionIndex + 1
Loop
MsgBox "Job Done"
End Sub

 

[Volker Hormuth]

Hello Patrick,

many thanks for your help. The code runs as desired.
The code I had postet I use to put on form tables. These are saved in an
other step as Workbooks.
I ask my error to excuse.

Volker

 

[Patrick Molloy]

glad to have helped

Hello Patrick,

many thanks for your help. The code runs as desired.
The code I had postet I use to put on form tables. These are saved in an
other step as Workbooks.
I ask my error to excuse.

Volker