Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
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
Posted to microsoft.public.excel.programming
|
|||
|
|||
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
Posted to microsoft.public.excel.programming
|
|||
|
|||
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
Posted to microsoft.public.excel.programming
|
|||
|
|||
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 |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
code to check condition for each row | Excel Discussion (Misc queries) | |||
How to code macro with if condition? | Excel Programming | |||
Condition Formatting in code. How? | Excel Programming | |||
Condition Formatting in code. How? | Excel Programming | |||
Condition Formatting in code. How? | Excel Programming |