skip to next part of program if a cell blank

[SteveC]

Hello, here is my code. How do I modify it so that if a range is blank, it
will move on to the next step. For example, if the cells in A2:A1000 are
blank, how do I get the program to move on to Step 2? And if B2:B1000 are
blank, how do I get it to move on to step 3? and etc...

Sub Update_Performance()

'Step 1
Sheets("Input").Select
Range("A2:A1000").Select
Selection.Copy
Sheets("HL").Select
Range("D2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False


'Step 2
Sheets("Input").Select
Range("b2:b1000").Select
Selection.Copy
Sheets("HL2").Select
Range("D2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False

'Step 3
Sheets("Input").Select
Range("c2:c1000").Select
Selection.Copy
Sheets("HL3").Select
Range("D2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False

'Step etc... to Step 70

end sub

 

[Bob Umlas]

ALL your code can be reduced to this (unless you didn't really supply it
all):

Sub Update_Performance()
For i = 1 To 70
Set mainrange = Sheets("Input").Cells(2, i).Resize(999)
If Application.CountA(mainrange) <> 0 Then
mainrange.Copy
Sheets("HL" & IIf(i = 1, "", i)).Range("D2").PasteSpecial
xlPasteValues
End If
Next
End Sub

Yes -- this is all 70 steps!
Bob Umlas
Excel MVP

 

[meh2030]

Hello, here is my code.  How do I modify it so that if a range is blank, it
will move on to the next step.  For example, if the cells in A2:A1000 are
blank, how do I get the program to move on to Step 2?  And if B2:B1000 are
blank, how do I get it to move on to step 3? and etc...

Sub Update_Performance()

'Step 1
    Sheets("Input").Select
    Range("A2:A1000").Select
    Selection.Copy
    Sheets("HL").Select
    Range("D2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
        :=False, Transpose:=False

'Step 2
    Sheets("Input").Select
    Range("b2:b1000").Select
    Selection.Copy
    Sheets("HL2").Select
    Range("D2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
        :=False, Transpose:=False

'Step 3
    Sheets("Input").Select
    Range("c2:c1000").Select
    Selection.Copy
    Sheets("HL3").Select
    Range("D2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
        :=False, Transpose:=False

'Step etc... to Step 70

end sub

Steve,

You can try something like what is listed below. It will benefit you
to look into using a For loop. If I have more time later, I'll send
an example of a For loop for your situation.

Sub TestIt()
Dim wksCopySheet As Worksheet
Dim wksPasteSheet As Worksheet
Dim rngCopy As Range
Dim rngPaste As Range
Dim strCellOutput As String

'set constant variables
Set wksCopySheet = Worksheets("Input")
strCellOutput = "D2"

'Step 1
Set rngCopy = wksCopySheet.Range("A2:A1000")
Set wksPasteSheet = Worksheets("HL")
Set rngPaste = wksPasteSheet.Range(strCellOutput)

If Application.WorksheetFunction.CountA(rngCopy) <> 0 Then
rngCopy.Copy
rngPaste.PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
End If

'Step 2
Set rngCopy = wksCopySheet.Range("B2:B1000")
Set wksPasteSheet = Worksheets("HL2")
Set rngPaste = wksPasteSheet.Range(strCellOutput)

If Application.WorksheetFunction.CountA(rngCopy) <> 0 Then
rngCopy.Copy
rngPaste.PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
End If

'Other Steps

End Sub

Matt

 

[SteveC]

wow, very nice, thanks. you reduced 10000 lines to 10 lines. haha.

well, here is the full code if u r still interested... you still have some
tricks up your sleave?

would it still work if I had 100 worksheets, not 70?

Sub Update_Performance()

Application.Run "clear_first"

Application.Run "label"

'xxxxxxxxxxxxxxxxxxxxxxxxxxxxx


Dim LastRow As Long

Sheets("StockInput").Select
Range("A2:A1000").Select
Selection.Copy
Sheets("HL").Select
Range("D2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False

With Worksheets("HL")
LastRow = .Cells(Rows.Count, "D").End(xlUp).Row
..Range("a2:c2").AutoFill Destination:=.Range("a2:c" & LastRow) _
, Type:=xlFillDefault

End With

With Worksheets("HL")
LastRow = .Cells(Rows.Count, "D").End(xlUp).Row
..Range("e2:af2").AutoFill Destination:=.Range("e2:af" & LastRow) _
, Type:=xlFillDefault

End With

'xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx

Sheets("StockInput").Select
Range("B2:B1000").Select
Selection.Copy
Sheets("HL (2)").Select
Range("D2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False

With Worksheets("HL (2)")
LastRow = .Cells(Rows.Count, "D").End(xlUp).Row
..Range("a2:c2").AutoFill Destination:=.Range("a2:c" & LastRow) _
, Type:=xlFillDefault

End With

With Worksheets("HL (2)")
LastRow = .Cells(Rows.Count, "D").End(xlUp).Row
..Range("e2:af2").AutoFill Destination:=.Range("e2:af" & LastRow) _
, Type:=xlFillDefault

End With

'xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx

Sheets("StockInput").Select
Range("C2:c1000").Select
Selection.Copy
Sheets("HL (3)").Select
Range("D2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False

With Worksheets("HL (3)")
LastRow = .Cells(Rows.Count, "D").End(xlUp).Row
..Range("a2:c2").AutoFill Destination:=.Range("a2:c" & LastRow) _
, Type:=xlFillDefault

End With

With Worksheets("HL (3)")
LastRow = .Cells(Rows.Count, "D").End(xlUp).Row
..Range("e2:af2").AutoFill Destination:=.Range("e2:af" & LastRow) _
, Type:=xlFillDefault

End With

'xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx

'etc. to sheet HL (70)xxxxxxxxxxxxxx

End sub

 

[SteveC]

thanks matt, I will try this one out over the weekend.