Reply
 
LinkBack Thread Tools Search this Thread Display Modes
  #1   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 386
Default Code condition

The following code is supposed to:

1) Delete all the entries on sheets 2-5, (named Urgences, Imperatifs,
Importants, Repariations), from cells B6 to J(end)
2) Copy any cells with a value of 10 in row K and an X in row V from Données
to Urgences, and this continues for all of the values 10,8,6,4,2 all going to
different sheets. In other others columns in Données I have a mix of number
entries, text enrties etc some of which come from drop down lists.

At the moment the code ONLY copies the data IF I have something written in
cell I - this should not be part of code. Whether or not something is
written in col I the code should copy the necessary data.

I have tried changing every other item in the list to see if there is
another condition affecting it - there is not.

Does anyone know why this would be happening and how to resolve it?

Thanks
LiAD



Private Sub Workbook_Open()
Dim lr As Long, rng As Range
Dim lr2 As Long, lr3 As Long
Dim ws1 As Worksheet, ws2 As Worksheet
Dim ws3 As Worksheet, ws4 As Worksheet
Dim ws5 As Worksheet
Set ws1 = Sheets("Données")
Set ws2 = Sheets("Urgences")
Set ws3 = Sheets("Imperatifs")
Set ws4 = Sheets("Importants")
Set ws5 = Sheets("Repariations")
ws2.Range("B6:J" & Cells(10, 2).End(xlDown).Row).Delete
ws3.Range("B6:J" & Cells(10, 2).End(xlDown).Row).Delete
ws4.Range("B6:J" & Cells(10, 2).End(xlDown).Row).Delete
ws5.Range("B6:J" & Cells(10, 2).End(xlDown).Row).Delete
lr = ws1.Cells(ws1.Rows.Count, "K").End(xlUp).Row
Set rng = ws1.Range("K9:K" & lr)
Application.DisplayAlerts = False
For Each c In rng

If c.Value = 2 And UCase(Range("v" & c.Row).Value) = "X" Then
lr2 = ws5.Cells(ws5.Rows.Count, 9).End(xlUp).Row
If lr2 < 6 Then lr2 = 5
Range("B" & c.Row & ":J" & c.Row).Copy ws5.Range("B" & lr2 + 1)

ElseIf c.Value = 4 And UCase(Range("v" & c.Row).Value) = "X" Then
lr2 = ws4.Cells(ws4.Rows.Count, 9).End(xlUp).Row
If lr2 < 6 Then lr2 = 5
Range("B" & c.Row & ":J" & c.Row).Copy ws4.Range("B" & lr2 + 1)

ElseIf c.Value = 6 And UCase(Range("v" & c.Row).Value) = "X" Then
lr2 = ws4.Cells(ws4.Rows.Count, 9).End(xlUp).Row
If lr2 < 6 Then lr2 = 5
Range("B" & c.Row & ":J" & c.Row).Copy ws4.Range("B" & lr2 + 1)

End If
Next

Set rng = ws1.Range("K9:K" & lr)
Application.DisplayAlerts = False
For Each c In rng

If c.Value = 8 And UCase(Range("v" & c.Row).Value) = "X" Then
lr2 = ws3.Cells(ws3.Rows.Count, 9).End(xlUp).Row
If lr2 < 6 Then lr2 = 5
Range("B" & c.Row & ":J" & c.Row).Copy ws3.Range("B" & lr2 + 1)

ElseIf c.Value = 10 And UCase(Range("v" & c.Row).Value) = "X" Then
lr3 = ws2.Cells(ws2.Rows.Count, 9).End(xlUp).Row
If lr3 < 6 Then lr3 = 5
Range("B" & c.Row & ":J" & c.Row).Copy ws2.Range("B" & lr3 + 1)

End If
Next
Application.DisplayAlerts = True
ThisWorkbook.Save
End Sub

  #2   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 2,069
Default Code condition

Do not have time to test your code but just an idea, I note that although you
have created an object reference to each worksheet, you have not qualified
some of the Range & Cell checks / tests to them - it may be, the your code
is returning results from the wrong sheet & this is why it fails??

I have added what I think you have omitted but check then see if this helps.

Private Sub Workbook_Open()
Dim lr As Long, rng As Range
Dim lr2 As Long, lr3 As Long
Dim ws1 As Worksheet, ws2 As Worksheet
Dim ws3 As Worksheet, ws4 As Worksheet
Dim ws5 As Worksheet

Set ws1 = Sheets("Données")
Set ws2 = Sheets("Urgences")
Set ws3 = Sheets("Imperatifs")
Set ws4 = Sheets("Importants")
Set ws5 = Sheets("Repariations")

ws2.Range("B6:J" & ws2.Cells(10, 2).End(xlDown).Row).Delete
ws3.Range("B6:J" & ws3.Cells(10, 2).End(xlDown).Row).Delete
ws4.Range("B6:J" & ws4.Cells(10, 2).End(xlDown).Row).Delete
ws5.Range("B6:J" & ws5.Cells(10, 2).End(xlDown).Row).Delete

lr = ws1.Cells(ws1.Rows.Count, "K").End(xlUp).Row

Set rng = ws1.Range("K9:K" & lr)

Application.DisplayAlerts = False

For Each c In rng

If c.Value = 2 And UCase(ws1.Range("v" & c.Row).Value) = "X" Then

lr2 = ws5.Cells(ws5.Rows.Count, 9).End(xlUp).Row

If lr2 < 6 Then lr2 = 5

ws1.Range("B" & c.Row & ":J" & c.Row).Copy ws5.Range("B" & lr2 +
1)

ElseIf c.Value = 4 And UCase(ws1.Range("v" & c.Row).Value) = "X" Then

lr2 = ws4.Cells(ws4.Rows.Count, 9).End(xlUp).Row

If lr2 < 6 Then lr2 = 5

ws1.Range("B" & c.Row & ":J" & c.Row).Copy ws4.Range("B" & lr2 +
1)

ElseIf c.Value = 6 And UCase(ws1.Range("v" & c.Row).Value) = "X" Then

lr2 = ws4.Cells(ws4.Rows.Count, 9).End(xlUp).Row

If lr2 < 6 Then lr2 = 5

ws1.Range("B" & c.Row & ":J" & c.Row).Copy ws4.Range("B" & lr2 +
1)

End If
Next

Set rng = ws1.Range("K9:K" & lr)
Application.DisplayAlerts = False
For Each c In rng

If c.Value = 8 And UCase(ws1.Range("v" & c.Row).Value) = "X" Then

lr2 = ws3.Cells(ws3.Rows.Count, 9).End(xlUp).Row

If lr2 < 6 Then lr2 = 5

ws1.Range("B" & c.Row & ":J" & c.Row).Copy ws3.Range("B" & lr2 +
1)

ElseIf c.Value = 10 And UCase(ws1.Range("v" & c.Row).Value) = "X" Then
lr3 = ws2.Cells(ws2.Rows.Count, 9).End(xlUp).Row
If lr3 < 6 Then lr3 = 5

ws1.Range("B" & c.Row & ":J" & c.Row).Copy ws2.Range("B" & lr3 +
1)

End If
Next

Application.DisplayAlerts = True

ThisWorkbook.Save

End Sub

--
jb


"LiAD" wrote:

The following code is supposed to:

1) Delete all the entries on sheets 2-5, (named Urgences, Imperatifs,
Importants, Repariations), from cells B6 to J(end)
2) Copy any cells with a value of 10 in row K and an X in row V from Données
to Urgences, and this continues for all of the values 10,8,6,4,2 all going to
different sheets. In other others columns in Données I have a mix of number
entries, text enrties etc some of which come from drop down lists.

At the moment the code ONLY copies the data IF I have something written in
cell I - this should not be part of code. Whether or not something is
written in col I the code should copy the necessary data.

I have tried changing every other item in the list to see if there is
another condition affecting it - there is not.

Does anyone know why this would be happening and how to resolve it?

Thanks
LiAD



Private Sub Workbook_Open()
Dim lr As Long, rng As Range
Dim lr2 As Long, lr3 As Long
Dim ws1 As Worksheet, ws2 As Worksheet
Dim ws3 As Worksheet, ws4 As Worksheet
Dim ws5 As Worksheet
Set ws1 = Sheets("Données")
Set ws2 = Sheets("Urgences")
Set ws3 = Sheets("Imperatifs")
Set ws4 = Sheets("Importants")
Set ws5 = Sheets("Repariations")
ws2.Range("B6:J" & Cells(10, 2).End(xlDown).Row).Delete
ws3.Range("B6:J" & Cells(10, 2).End(xlDown).Row).Delete
ws4.Range("B6:J" & Cells(10, 2).End(xlDown).Row).Delete
ws5.Range("B6:J" & Cells(10, 2).End(xlDown).Row).Delete
lr = ws1.Cells(ws1.Rows.Count, "K").End(xlUp).Row
Set rng = ws1.Range("K9:K" & lr)
Application.DisplayAlerts = False
For Each c In rng

If c.Value = 2 And UCase(Range("v" & c.Row).Value) = "X" Then
lr2 = ws5.Cells(ws5.Rows.Count, 9).End(xlUp).Row
If lr2 < 6 Then lr2 = 5
Range("B" & c.Row & ":J" & c.Row).Copy ws5.Range("B" & lr2 + 1)

ElseIf c.Value = 4 And UCase(Range("v" & c.Row).Value) = "X" Then
lr2 = ws4.Cells(ws4.Rows.Count, 9).End(xlUp).Row
If lr2 < 6 Then lr2 = 5
Range("B" & c.Row & ":J" & c.Row).Copy ws4.Range("B" & lr2 + 1)

ElseIf c.Value = 6 And UCase(Range("v" & c.Row).Value) = "X" Then
lr2 = ws4.Cells(ws4.Rows.Count, 9).End(xlUp).Row
If lr2 < 6 Then lr2 = 5
Range("B" & c.Row & ":J" & c.Row).Copy ws4.Range("B" & lr2 + 1)

End If
Next

Set rng = ws1.Range("K9:K" & lr)
Application.DisplayAlerts = False
For Each c In rng

If c.Value = 8 And UCase(Range("v" & c.Row).Value) = "X" Then
lr2 = ws3.Cells(ws3.Rows.Count, 9).End(xlUp).Row
If lr2 < 6 Then lr2 = 5
Range("B" & c.Row & ":J" & c.Row).Copy ws3.Range("B" & lr2 + 1)

ElseIf c.Value = 10 And UCase(Range("v" & c.Row).Value) = "X" Then
lr3 = ws2.Cells(ws2.Rows.Count, 9).End(xlUp).Row
If lr3 < 6 Then lr3 = 5
Range("B" & c.Row & ":J" & c.Row).Copy ws2.Range("B" & lr3 + 1)

End If
Next
Application.DisplayAlerts = True
ThisWorkbook.Save
End Sub

  #3   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 523
Default Code condition

Hi LiAD,

It will copy data where cell I is empty, but it'll then overwrite it with
the next row. You have this:

lr2 = ws5.Cells(ws5.Rows.Count, 9).End(xlUp).Row

In various places - that's looking for the last cell in column I, so if that
cell is blank then the row will be copied over. Maybe change that 9 to a
different number to use a column that's always populated.

Sam


"LiAD" wrote:

The following code is supposed to:

1) Delete all the entries on sheets 2-5, (named Urgences, Imperatifs,
Importants, Repariations), from cells B6 to J(end)
2) Copy any cells with a value of 10 in row K and an X in row V from Données
to Urgences, and this continues for all of the values 10,8,6,4,2 all going to
different sheets. In other others columns in Données I have a mix of number
entries, text enrties etc some of which come from drop down lists.

At the moment the code ONLY copies the data IF I have something written in
cell I - this should not be part of code. Whether or not something is
written in col I the code should copy the necessary data.

I have tried changing every other item in the list to see if there is
another condition affecting it - there is not.

Does anyone know why this would be happening and how to resolve it?

Thanks
LiAD



Private Sub Workbook_Open()
Dim lr As Long, rng As Range
Dim lr2 As Long, lr3 As Long
Dim ws1 As Worksheet, ws2 As Worksheet
Dim ws3 As Worksheet, ws4 As Worksheet
Dim ws5 As Worksheet
Set ws1 = Sheets("Données")
Set ws2 = Sheets("Urgences")
Set ws3 = Sheets("Imperatifs")
Set ws4 = Sheets("Importants")
Set ws5 = Sheets("Repariations")
ws2.Range("B6:J" & Cells(10, 2).End(xlDown).Row).Delete
ws3.Range("B6:J" & Cells(10, 2).End(xlDown).Row).Delete
ws4.Range("B6:J" & Cells(10, 2).End(xlDown).Row).Delete
ws5.Range("B6:J" & Cells(10, 2).End(xlDown).Row).Delete
lr = ws1.Cells(ws1.Rows.Count, "K").End(xlUp).Row
Set rng = ws1.Range("K9:K" & lr)
Application.DisplayAlerts = False
For Each c In rng

If c.Value = 2 And UCase(Range("v" & c.Row).Value) = "X" Then
lr2 = ws5.Cells(ws5.Rows.Count, 9).End(xlUp).Row
If lr2 < 6 Then lr2 = 5
Range("B" & c.Row & ":J" & c.Row).Copy ws5.Range("B" & lr2 + 1)

ElseIf c.Value = 4 And UCase(Range("v" & c.Row).Value) = "X" Then
lr2 = ws4.Cells(ws4.Rows.Count, 9).End(xlUp).Row
If lr2 < 6 Then lr2 = 5
Range("B" & c.Row & ":J" & c.Row).Copy ws4.Range("B" & lr2 + 1)

ElseIf c.Value = 6 And UCase(Range("v" & c.Row).Value) = "X" Then
lr2 = ws4.Cells(ws4.Rows.Count, 9).End(xlUp).Row
If lr2 < 6 Then lr2 = 5
Range("B" & c.Row & ":J" & c.Row).Copy ws4.Range("B" & lr2 + 1)

End If
Next

Set rng = ws1.Range("K9:K" & lr)
Application.DisplayAlerts = False
For Each c In rng

If c.Value = 8 And UCase(Range("v" & c.Row).Value) = "X" Then
lr2 = ws3.Cells(ws3.Rows.Count, 9).End(xlUp).Row
If lr2 < 6 Then lr2 = 5
Range("B" & c.Row & ":J" & c.Row).Copy ws3.Range("B" & lr2 + 1)

ElseIf c.Value = 10 And UCase(Range("v" & c.Row).Value) = "X" Then
lr3 = ws2.Cells(ws2.Rows.Count, 9).End(xlUp).Row
If lr3 < 6 Then lr3 = 5
Range("B" & c.Row & ":J" & c.Row).Copy ws2.Range("B" & lr3 + 1)

End If
Next
Application.DisplayAlerts = True
ThisWorkbook.Save
End Sub

  #4   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 386
Default Code condition

Perfect.

Problem fixed.

Thanks a lot

"Sam Wilson" wrote:

Hi LiAD,

It will copy data where cell I is empty, but it'll then overwrite it with
the next row. You have this:

lr2 = ws5.Cells(ws5.Rows.Count, 9).End(xlUp).Row

In various places - that's looking for the last cell in column I, so if that
cell is blank then the row will be copied over. Maybe change that 9 to a
different number to use a column that's always populated.

Sam


"LiAD" wrote:

The following code is supposed to:

1) Delete all the entries on sheets 2-5, (named Urgences, Imperatifs,
Importants, Repariations), from cells B6 to J(end)
2) Copy any cells with a value of 10 in row K and an X in row V from Données
to Urgences, and this continues for all of the values 10,8,6,4,2 all going to
different sheets. In other others columns in Données I have a mix of number
entries, text enrties etc some of which come from drop down lists.

At the moment the code ONLY copies the data IF I have something written in
cell I - this should not be part of code. Whether or not something is
written in col I the code should copy the necessary data.

I have tried changing every other item in the list to see if there is
another condition affecting it - there is not.

Does anyone know why this would be happening and how to resolve it?

Thanks
LiAD



Private Sub Workbook_Open()
Dim lr As Long, rng As Range
Dim lr2 As Long, lr3 As Long
Dim ws1 As Worksheet, ws2 As Worksheet
Dim ws3 As Worksheet, ws4 As Worksheet
Dim ws5 As Worksheet
Set ws1 = Sheets("Données")
Set ws2 = Sheets("Urgences")
Set ws3 = Sheets("Imperatifs")
Set ws4 = Sheets("Importants")
Set ws5 = Sheets("Repariations")
ws2.Range("B6:J" & Cells(10, 2).End(xlDown).Row).Delete
ws3.Range("B6:J" & Cells(10, 2).End(xlDown).Row).Delete
ws4.Range("B6:J" & Cells(10, 2).End(xlDown).Row).Delete
ws5.Range("B6:J" & Cells(10, 2).End(xlDown).Row).Delete
lr = ws1.Cells(ws1.Rows.Count, "K").End(xlUp).Row
Set rng = ws1.Range("K9:K" & lr)
Application.DisplayAlerts = False
For Each c In rng

If c.Value = 2 And UCase(Range("v" & c.Row).Value) = "X" Then
lr2 = ws5.Cells(ws5.Rows.Count, 9).End(xlUp).Row
If lr2 < 6 Then lr2 = 5
Range("B" & c.Row & ":J" & c.Row).Copy ws5.Range("B" & lr2 + 1)

ElseIf c.Value = 4 And UCase(Range("v" & c.Row).Value) = "X" Then
lr2 = ws4.Cells(ws4.Rows.Count, 9).End(xlUp).Row
If lr2 < 6 Then lr2 = 5
Range("B" & c.Row & ":J" & c.Row).Copy ws4.Range("B" & lr2 + 1)

ElseIf c.Value = 6 And UCase(Range("v" & c.Row).Value) = "X" Then
lr2 = ws4.Cells(ws4.Rows.Count, 9).End(xlUp).Row
If lr2 < 6 Then lr2 = 5
Range("B" & c.Row & ":J" & c.Row).Copy ws4.Range("B" & lr2 + 1)

End If
Next

Set rng = ws1.Range("K9:K" & lr)
Application.DisplayAlerts = False
For Each c In rng

If c.Value = 8 And UCase(Range("v" & c.Row).Value) = "X" Then
lr2 = ws3.Cells(ws3.Rows.Count, 9).End(xlUp).Row
If lr2 < 6 Then lr2 = 5
Range("B" & c.Row & ":J" & c.Row).Copy ws3.Range("B" & lr2 + 1)

ElseIf c.Value = 10 And UCase(Range("v" & c.Row).Value) = "X" Then
lr3 = ws2.Cells(ws2.Rows.Count, 9).End(xlUp).Row
If lr3 < 6 Then lr3 = 5
Range("B" & c.Row & ":J" & c.Row).Copy ws2.Range("B" & lr3 + 1)

End If
Next
Application.DisplayAlerts = True
ThisWorkbook.Save
End Sub

Reply
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes

Posting Rules

Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On


Similar Threads
Thread Thread Starter Forum Replies Last Post
code to check condition for each row Horatio J. Bilge, Jr. Excel Discussion (Misc queries) 3 February 10th 09 08:07 PM
How to code macro with if condition? Eric Excel Programming 2 March 16th 08 03:54 PM
Condition Formatting in code. How? Corey Excel Programming 1 August 11th 06 03:18 PM
Condition Formatting in code. How? raypayette[_45_] Excel Programming 1 August 11th 06 02:55 PM
Condition Formatting in code. How? Barb Reinhardt Excel Programming 0 August 11th 06 02:28 PM


All times are GMT +1. The time now is 12:46 PM.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
Copyright ©2004-2024 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"