cell range for an if statement

spq24

Board Regular
Joined
Jan 18, 2010
Messages
52
I am trying to set up a complicated macro.

basically i am running an if...then...else if statement and it loops through an entire column.

It's running through column T and there are cells that are populated and ones that are blank.

If the cell in column T is populated I wanted to copy the contents of cells in column A-S and paste it into a new sheet.

Example:
macro searches through the range and finds that cell T35 is populated. It copies A35-S35 in sheet 1 and it copies it and pastes it into sheet 2. and it will do this through out the loop whenever a cell in column T is populated.

Can anyone help?
 

Excel Facts

Round to nearest half hour?
Use =MROUND(A2,"0:30") to round to nearest half hour. Use =CEILING(A2,"0:30") to round to next half hour.

Dryver14

Well-known Member
Joined
Mar 22, 2010
Messages
2,396
Code:
Sub CopyAcross()
Dim i As Long
Dim LastRow As Long
Dim NextRow As Long
LastRow = Sheet1.Cells(Rows.Count, 20).End(xlUp).Row
NextRow = Sheet2.Cells(Rows.Count, 1).End(xlUp).Row
Sheet1.Activate
    For i = 1 To LastRow
        If Cells(i, 20).Value <> "" Then
        Cells(i, 1).Resize(1, 19).Copy Sheet2.Cells(NextRow, 1)
        NextRow = NextRow + 1
        End If
    Next i
End Sub
 

hiker95

Well-known Member
Joined
Apr 8, 2009
Messages
17,649
spq24,


See if this works for you without looping.


Sample worksheets before the macro:


Excel Workbook
ABCDEFGHIJKLMNOPQRST
1Title ABCDEFGHIJKLMNOPQRST
22222222222222222222
333333333333333333333
44444444444444444444
55555555555555555555five
66666666666666666666
777777777777777777777
88888888888888888888
99999999999999999999nine
10
Sheet1





Excel Workbook
ABCDEFGHIJKLMNOPQRST
1Title ABCDEFGHIJKLMNOPQRST
2
3
4
5
6
Sheet2





After the macro:


Excel Workbook
ABCDEFGHIJKLMNOPQRST
1Title ABCDEFGHIJKLMNOPQRST
233333333333333333333
35555555555555555555five
477777777777777777777
59999999999999999999nine
6
Sheet2





Please TEST this FIRST in a COPY of your workbook (always make a backup copy before trying new code, you never know what you might lose).


1. Copy the below code, by highlighting the code and pressing the keys CTRL + C
2. Open your workbook
3. Press the keys ALT + F11 to open the Visual Basic Editor
4. Press the keys ALT + I to activate the Insert menu
5. Press M to insert a Standard Module
6. Where the cursor is flashing, paste the code by pressing the keys CTRL + V
7. Press the keys ALT + Q to exit the Editor, and return to Excel
8. To run the macro from Excel, open the workbook, and press ALT + F8 to display the Run Macro Dialog. Double Click the macro's name to Run it.


Code:
Option Explicit
Sub CopyRows()
' hiker95, 03/07/2011
' http://www.mrexcel.com/forum/showthread.php?t=533700
Dim LR As Long, NR As Long, RC As Long
Application.ScreenUpdating = False
With Worksheets("Sheet1")
  LR = .Cells(Rows.Count, 1).End(xlUp).Row
  .AutoFilterMode = False
  With .Range("A1:T" & LR)
    .AutoFilter Field:=20, Criteria1:="<>"
    NR = Worksheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Offset(1).Row
    On Error Resume Next
    RC = 0
    RC = Application.Subtotal(103, .Range("T1:T" & LR)) - 1
    If RC > 1 Then
      .Range("A1").Offset(1).Resize(.Rows.Count - 1, 20).SpecialCells(12).Copy Worksheets("Sheet2").Range("A" & NR)
    End If
    On Error GoTo 0
    .AutoFilter
  End With
End With
Worksheets("Sheet2").Activate
Application.ScreenUpdating = True
End Sub


Then run the CopyRows macro.
 

Dryver14

Well-known Member
Joined
Mar 22, 2010
Messages
2,396
Hiker,

I tested my macro and it works,

Your code, at this time, is beyond my capabilities but what is missing from mine to answer the original question.

I ask because I want to learn.
 

spq24

Board Regular
Joined
Jan 18, 2010
Messages
52

ADVERTISEMENT

Awesome! worked perfectly Thanks I'll have more questions I'm sure as I get through this project so keep an eye out
 

hiker95

Well-known Member
Joined
Apr 8, 2009
Messages
17,649
spq24,

You are very welcome.

Glad I could help.

Come back anytime.
 

hiker95

Well-known Member
Joined
Apr 8, 2009
Messages
17,649

ADVERTISEMENT

Dryver14,

Your code works, but it loops thru every cell in column T. If there was a huge amount of raw data, this could take a lot of time.

See the below code with comments of what it is doing.


Code:
Option Explicit
Sub CopyRows()
' hiker95, 03/07/2011
' http://www.mrexcel.com/forum/showthread.php?t=533700
Dim LR As Long, NR As Long, RC As Long

'Turn off screen flicker.  Code will run faster.
Application.ScreenUpdating = False
With Worksheets("Sheet1")
  
  'Find the last row in column A = 1
  LR = .Cells(Rows.Count, 1).End(xlUp).Row
  
  'If AutoFilter is already set, then turn AutoFilter off
  .AutoFilterMode = False
  
  With .Range("A1:T" & LR)
    
    'AutoFilter the range, Field 20 = column T, for cells that are not empty
    .AutoFilter Field:=20, Criteria1:="<>"
    
    'Find the next available row in Sheet2, column A
    NR = Worksheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Offset(1).Row
    
    'The Subtotal 103 formula counts the visable rows of the filtered data
    'If there is an error with the Subtotal formula
    '  then RC RowsCount = 0
    '  then ignore the error
    On Error Resume Next
    RC = 0
    RC = Application.Subtotal(103, .Range("T1:T" & LR)) - 1
    
    'If RC RowsCount is greater than 1
    '  because the formula will count row 1 as 1
    '  then copy the visable rows to Sheet2
    If RC > 1 Then
      .Range("A1").Offset(1).Resize(.Rows.Count - 1, 20).SpecialCells(12).Copy Worksheets("Sheet2").Range("A" & NR)
    End If
    On Error GoTo 0
    
    'Turn off AutoFilter
    .AutoFilter
  End With
End With

'Activate, Select, the sheet where the data is being copied to
Worksheets("Sheet2").Activate
Application.ScreenUpdating = True
End Sub
 

Dryver14

Well-known Member
Joined
Mar 22, 2010
Messages
2,396
Thanks for the explaination Hiker,

I will copy it into a module to study,

I think my problem is I have no concept of a large database,

In any job i've had the max in any row has been about 500
 

spq24

Board Regular
Joined
Jan 18, 2010
Messages
52
Code:
Sub CopyAcross()
Dim i As Long
Dim LastRow As Long
Dim NextRow As Long
LastRow = Sheet1.Cells(Rows.Count, 20).End(xlUp).Row
NextRow = Sheet2.Cells(Rows.Count, 1).End(xlUp).Row
Sheet1.Activate
    For i = 1 To LastRow
        If Cells(i, 20).Value <> "" Then
        Cells(i, 1).Resize(1, 19).Copy Sheet2.Cells(NextRow, 1)
        NextRow = NextRow + 1
        End If
    Next i
End Sub
so it worked for what It to do for column t but now I need to do the same thing (individually into different sheets) for columns U through AE. I was just going to have it do it individually, and have that code run again referencing the different columns each time. When I did that it's saying "object required" what am I missing?
 

spq24

Board Regular
Joined
Jan 18, 2010
Messages
52
so it worked for what It to do for column t but now I need to do the same thing (individually into different sheets) for columns U through AE. I was just going to have it do it individually, and have that code run again referencing the different columns each time. When I did that it's saying "object required" what am I missing?
I think it may be because I was trying to name the sheet "sheet6" but it's actually sheet 10 while the code is referencing sheet 6. How can I have it reference a name?
 

Forum statistics

Threads
1,141,018
Messages
5,703,754
Members
421,313
Latest member
Mooncake1

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
Top