IF statement to end a FOR Loop in Excel 2K3

K

kholton01

New Member
Joined
Apr 2, 2013
Messages
2
Hi all!

i have a For loop with in a macro i use which copies specific cell from one sheet into a row on another, but one of the sections can have multiple inputs (Cells F11:F20) basically the loop runs through each section copying over these cells but will change for each F Cell. However all 10 cells may not be used so i dont want the same row being copied over multiple times, is there a way that i can add an IF statement into the loop to say that if F & X is blank to either move to the next X value, or end the loop completely? the loop which i have is as follows;

For X = 11 To 20
LR = Sheets("Back End Table").Range("A" & Rows.Count).End(xlUp).Row + 1
Else

'ID
Range("C5").Select
Selection.Copy
Sheets("Back End Table").Select
Range("A" & LR).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Add Account").Select

'SUFFIX
Range("D5").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Back End Table").Select
Range("B" & LR).Select
Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Sheets("Add Account").Select

'FIRST NAME
Range("B7:C7").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Back End Table").Select
Range("C" & LR).Select
Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Sheets("Add Account").Select

'SURNAME
Range("B8:C8").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Back End Table").Select
Range("D" & LR).Select
Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Sheets("Add Account").Select

'EMPLOYEE ID
Range("F7").Select
Application.CutCopyMode = False
election.Copy
Sheets("Back End Table").Select
Range("E" & LR).Select
Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Sheets("Add Account").Select

'NETWORK LOGIN
Range("F8").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Back End Table").Select
Range("F" & LR).Select
election.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Sheets("Add Account").Select

'LOCATION
Range("B9:C9").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Back End Table").Select
Range("G" & LR).Select
Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Sheets("Add Account").Select

'ADMIN GROUP
Range("B11:C11").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Back End Table").Select
Range("H" & LR).Select
Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Sheets("Add Account").Select

 'BUSINESS GROUP
Range("F" & X).Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Back End Table").Select
Range("I" & LR).Select
Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Sheets("Add Account").Select
'WORK CLASS
Range("B12:C12").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Back End Table").Select
Range("J" & LR).Select
Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Sheets("Add Account").Select

'DATA CLASS
Range("B13:C13").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Back End Table").Select
Range("K" & LR).Select
Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Sheets("Add Account").Select

'CASEWORK
Range("B15:C15").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Back End Table").Select
Range("L" & LR).Select
Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Sheets("Add Account").Select

'ARL
Range("B16:C16").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Back End Table").Select
Range("M" & LR).Select
Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Sheets("Add Account").Select

'LETTER SIG
Range("B18:C18").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Back End Table").Select
Range("N" & LR).Select
Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Sheets("Add Account").Select

'DMS
Range("B20:C20").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Back End Table").Select
Range("O" & LR).Select
Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Sheets("Add Account").Select
Next X

The section labelled "Business group" (i have higlighted in blue) contains the cells that can have multiple values.

if any more information is needed please let me know!

any help will be greatly appreciated!

Regards

Kieran
 

Excel Facts

Which came first: VisiCalc or Lotus 1-2-3?
Dan Bricklin and Bob Frankston debuted VisiCalc in 1979 as a Visible Calculator. Lotus 1-2-3 debuted in the early 1980's, from Mitch Kapor.
Sort by date Sort by votes
Try this:
Code: 
'BUSINESS GROUP
If Range("F" & X) <> "" Then
Range("F" & X).Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Back End Table").Select
Range("I" & LR).Select
Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
End If
Sheets("Add Account").Select
 
Upvote 0
Ask the question at the beginning of the loop:
Code: 
For X = 11 To 20
  If Len(Sheets("Add Account").Range("F" & X).Value) > 0 Then
    LR = Sheets("Back End Table").Range("A" & Rows.Count).End(xlUp).Row + 1
    'Else'I don't know what that Else is doing there!

    'all that code..

    Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Sheets("Add Account").Select
  End If
Next X
or:
Code: 
For X = 11 To 20
  If Len(Sheets("Add Account").Range("F" & X).Value) = 0 Then Exit For 'if the first blank encountered means the rest are blank.
  LR = Sheets("Back End Table").Range("A" & Rows.Count).End(xlUp).Row + 1
  'Else'I don't know what that Else is doing there!

  'all that code..

  Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
  Sheets("Add Account").Select
Next X

BTW, you can considerably shorten your code; this:
Code: 
    Range("B20:C20").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Back End Table").Select
    Range("O" & LR).Select
    Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Sheets("Add Account").Select
becomes:
Code: 
    Sheets("Add Account").Range("B20:C20").Copy
    Sheets("Back End Table").Range("O" & LR).PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
and you only need to Application.CutCopyMode = False once at the end of the routine before you return control back to the user.
 
Last edited:
Upvote 0
p45cal said:
Ask the question at the beginning of the loop:
Code: 
For X = 11 To 20
  If Len(Sheets("Add Account").Range("F" & X).Value) > 0 Then
    LR = Sheets("Back End Table").Range("A" & Rows.Count).End(xlUp).Row + 1
    'Else'I don't know what that Else is doing there!

    'all that code..

    Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Sheets("Add Account").Select
  End If
Next X
or:
Code: 
For X = 11 To 20
  If Len(Sheets("Add Account").Range("F" & X).Value) = 0 Then Exit For 'if the first blank encountered means the rest are blank.
  LR = Sheets("Back End Table").Range("A" & Rows.Count).End(xlUp).Row + 1
  'Else'I don't know what that Else is doing there!

  'all that code..

  Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
  Sheets("Add Account").Select
Next X

BTW, you can considerably shorten your code; this:
Code: 
    Range("B20:C20").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Back End Table").Select
    Range("O" & LR).Select
    Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Sheets("Add Account").Select
becomes:
Code: 
    Sheets("Add Account").Range("B20:C20").Copy
    Sheets("Back End Table").Range("O" & LR).PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
and you only need to Application.CutCopyMode = False once at the end of the routine before you return control back to the user.
Click to expand...


WOOHOO! thank you, yeaa i know the code was rediculously long but i used the recorder (i guess being lazy doesnt pay off!) Much appreciated mate
 
Upvote 0
You must log in or register to reply here.

Similar threads

P
  • Solved
Counter in For Each loop
Replies
2
Views
171
Possum17
P
A
  • Question
Macro to update list to last row on another sheet copy source from multiple sheets
Replies
0
Views
296
Azamamir
A
P
  • Solved
Need help with macro Dynamic Range??
Replies
6
Views
155
pennbowl
P
R
  • Solved
How to loop a macro
Replies
2
Views
337
rlcurlee
R
J
  • Question
VBA to select partial filename and go back and forth between two files to copy paste
Replies
1
Views
156
shknbk2
S

Forum statistics

Threads
1,214,381
Messages
6,119,192
Members
448,874
Latest member
Lancelots

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top