Range selection problem

  • Thread starter Thread starter SotjeRuud
  • Start date Start date
S

SotjeRuud

Dear all,

How are you all doing? I encountered a problem concerning the selection of
lines in a sheet and "working" with those lines.
The following code works sufficient when there is more than one line in the
sheet. Every once in a while there is a sheet with just one line. And as you
can imagine the files than explodes because of the use of the xl-down in the
copy-paste function.
Because the sheet has to be mailed, this results in a great problem.
Upfront I cannot tell how many lines will be in the file, that's why I tried
to do it like this.

Does anyone have any suggestions on how to solve this?

Thanks in advance
Kind regards
Ruud
----------------------------------------------------------------------------
---------------------------------------------
Private Sub CommandButton2_Click()
'DEMAND MANAGEMENT DONE
'check 1 --> if status = 1,5 dan Naar_exit
'check 2 --> if status =2 dan Naar Demandmgt_done
'check 3 --> if status =3,4 dan Naar_actie_al_gedaan_D
If Sheets("site order").Cells(8, 10).Value < 2 Then Naar_Exit Else If
Sheets("site order").Cells(8, 10).Value = 5 Then Naar_Exit Else If
Sheets("site order").Cells(8, 10).Value = 2 Then Naar_demandmgt_done Else If
3 < Sheets("site order").Cells(8, 10).Value < 4 Then Naar_Actie_al_gedaan_D
Else: Naar_Exit
End Sub

----------------------------------------------------------------------------
---------------------------------------------
Public Sub Naar_demandmgt_done()
'Sheets visible
Sheets("Call off").Visible = True
Sheets("Reconfiguration").Visible = True

'CREATE CALL OFF SHEET

'clear all lines in "call off" sheet
Sheets("call off").Activate
'Sheets("call off").Range("a24:I100").ClearContents
With Sheets("Call Off")
.Range(.Cells(24, 1), .Cells(100, 9)).ClearContents
End With

'Copy and paste new lines
With Sheets("Site Order")
Range( _
.Range("A24:i24"), _
.Range("A24:i24").End(xlDown)).Copy _
Sheets("Call Off").Cells(24, 1)
End With

'sort the lines
Sheets("Call Off").Select
RowVar2 = Rows.Count
Worksheets("Call Off").Range("A24:i" & RowVar2).Sort _
Key1:=Worksheets("Call Off").Range("E24"), _
Key2:=Worksheets("Call Off").Range("B24")

'Count the number of reconfiguration lines to remove other lines.
PurchLineVar = WorksheetFunction.CountIf(Range(Cells(24, 5), Cells(100,
5)), "1-Reconfig") + WorksheetFunction.CountIf(Range(Cells(24, 5),
Cells(100, 5)), "2-Stock")
'All lines that have no reconfiguration in column "demand management" are
removed
With Sheets("Call Off")
.Range(.Cells(24 + PurchLineVar, 1), .Cells(RowVar2,
9)).ClearContents
End With
'change background color from blue to white --> indication for user who is
responsible for data entry
With Sheets("Call Off")
.Range(.Cells(24, 2), .Cells(72, 4)).Interior.ColorIndex = 2
End With
Sheets("Call Off").Cells(1, 1).Select

' CREATE THE RECONFIGURATION ORDER
' Copy all lines from the Site Order to the Reconfiguration form and sort
them with Reconfig on top.
remove old lines from Reconfiguration sheet
With Sheets("Reconfiguration")
.Range(.Cells(24, 1), .Cells(100, 9)).ClearContents
End With
'Copy and paste new lines
With Sheets("Site Order")
Range( _
.Range("A24:I24"), _
.Range("A24:I24").End(xlDown)).Copy _
Sheets("Reconfiguration").Cells(24, 1)
End With

'sort the lines
Sheets("reconfiguration").Select
RowVar = Rows.Count
Worksheets("Reconfiguration").Range("A24:I" & RowVar).Sort _
Key1:=Worksheets("Reconfiguration").Range("E24"), _
Key2:=Worksheets("Reconfiguration").Range("B24")

'Count the number of reconfiguration lines to remove other lines.
Activereconvar = WorksheetFunction.CountIf(Range(Cells(24, 5),
Cells(100, 5)), "1-Reconfig")
'All lines that have no reconfiguration in column "demand management" are
removed
With Sheets("Reconfiguration")
.Range(.Cells(Activereconvar + 24, 1), .Cells(RowVar,
9)).ClearContents
End With
'update creation date in Call off and in Reconfiguration
Sheets("Call off").Cells(8, 3).Value = Date
Sheets("Reconfiguration").Cells(8, 3).Value = Date
'change background color from blue to white --> indication for user who is
responsible for data entry
With Sheets("Reconfiguration")
.Range(.Cells(24, 2), .Cells(72, 4)).Interior.ColorIndex = 2
End With
Sheets("Reconfiguration").Cells(1, 1).Select
'sheet Reconfiguration visible or not
Sheets("Site Order").Activate
Activereconvar = WorksheetFunction.CountIf(Range(Cells(24, 5),
Cells(100, 5)), "1-Reconfig")
If Activereconvar = 0 Then Sheets("Reconfiguration").Visible = False
Else Sheets("Reconfiguration").Visible = True
'Update status
Sheets("Site Order").Cells(8, 3).Value = Sheets("blad3").Cells(14,
6).Value
Sheets("site Order").Activate

'Last change by whom and date
Sheets("blad3").Activate
Sheets("Blad3").Cells(30, 2).Select
Selection.Copy
Sheets("site Order").Activate
Cells(5, 9).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Sheets("blad3").Activate
Sheets("Blad3").Cells(31, 2).Select
Selection.Copy
Sheets("site Order").Activate
Cells(6, 9).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Cells(1, 1).Select
'Change color User name
With Sheets("Site Order")
.Range(.Cells(5, 9), .Cells(6, 9)).Font.ColorIndex = 5
End With

End Sub
 
You need to check the situation

Can we assume that Column A will have data on each line that has data

Dim rng as Range
.. . .
'Copy and paste new lines
With Sheets("Site Order")
set rng = .Cells(rows.count,1).End(xlup)
Range( _
.Range("A24"), _
rng).Resize(,9).Copy _
Sheets("Call Off").Cells(24, 1)
End With

This assumes there is always at least a value A24.

Make a similar change in other code like this section.
 
Back
Top