Copying across values based on criteria

Z

Zak

I'd like to copy a certain number of columns from 1 sheet into another to
form a report - but based on criteria.

Firsly id like to tell the macro to custom filter column Z to show
everything outstanding which is "less than 0".

Once this is filtered i need to tell the macro to copy columns H-O, X, Y,
etc and then all this information would go into another sheet within the same
workbook.

Also, if i can get any code so that i can put colours/borders around the
data extracted i would be very grateful.

Please can you offer some help?

thanks.
 
G

GTVT06

Hello,

You can do something along the lines of this for the code:

Dim cell As Range
'Hides each row if Z >= "0"
For Each cell In Range("Z2:Z65536")
If cell.Value >= "0" Then
cell.Rows.Hidden = True
End If
Next cell
'selects columns
For Each cell In Range("Z2:Z65536")
If cell.Rows.Hidden = False Then
If cell.Value > "" Then
Range("H" & cell.Rows.Row & ":" & "O" & cell.Rows.Row & "," _
& "X" & cell.Rows.Row & ":" & "Y" & cell.Rows.Row).Select
'paste them to other sheet
Selection.Copy _
Worksheets("Sheet2").Range("A1")
End If
End If
Next cell

As for the Colors and the Borders, you can use conditional formating
to color or border the cell if the cell is <>""
 
Z

Zak

I modified the code as below but its not doing what i want it to...

I added a few more columns that i want it to extract - i dont think i have
done it correctly!

Also, in the "sheet" where i want it to put this information i have stated
"report" but i would like for it to just put the information into a new sheet
because the "report" sheet may not always be there.. how do i do this?

thanks alot.

Sub tracker1()
Dim cell As Range
'Hides each row if Z >= "0"
For Each cell In Range("Z2:Z65536")
If cell.Value > "0" Then
cell.Rows.Hidden = True
End If
Next cell
'selects columns
For Each cell In Range("Z2:Z65536")
If cell.Rows.Hidden = False Then
If cell.Value > "" Then
Range("C" & cell.Rows.Row & "D" & "G" & "H" & "T" & "U" & "V" & "W" &
"X" & cell.Rows.Row & "," _
& "Y" & cell.Rows.Row & "Z" & "AM" & cell.Rows.Row).Select
'paste them to other sheet
Selection.Copy _
Worksheets("Report").Range("A1")
End If
End If
Next cell
End Sub
 
Z

Zak

Please can you help on the below? also, while i was trying to fix the code
myself (having no luck!) i noticed a couple of things missing/not functioning
properly, for example, additional to if anything is 0 then hide these rows i
also want to say if anything is blank then hide these rows (within the same
column -Z). When i ran this macro although it wasnt pulling across the right
info i noticed that what it did copy across into the new sheet was literally
just one row from the spredsheet as opposed to all the selected information
to be diaplayed in a formatted way in another sheet.


please help! thanks.
 
G

GTVT06

Please can you help on the below? also, while i was trying to fix the code
myself (having no luck!) i noticed a couple of things missing/not functioning
properly, for example, additional to if anything is 0 then hide these rowsi
also want to say if anything is blank then hide these rows (within the same
column -Z). When i ran this macro although it wasnt pulling across the right
info i noticed that what it did copy across into the new sheet was literally
just one row from the spredsheet as opposed to all the selected information
to be diaplayed in a formatted way in another sheet.

please help! thanks.










- Show quoted text -
Click to expand...

Sorry about that, I added a quick fix so it will paste the data in
multiple rows on the other sheet. I will look into your other request
and get back with you shortly

Dim cell As Range
'Hides each row if Z >= "0"
For Each cell In Range("Z2:Z65536")
If cell.Value >= "0" Then
cell.Rows.Hidden = True
End If
Next cell
'selects columns
For Each cell In Range("Z2:Z65536")
If cell.Rows.Hidden = False Then
If cell.Value > "" Then
Range("H" & cell.Rows.Row & ":" & "O" & cell.Rows.Row & "," _
& "X" & cell.Rows.Row & ":" & "Y" & cell.Rows.Row).Select
'paste them to other sheet
Selection.Copy
Worksheets("Sheet2").Activate
Range("A65536").End(xlUp).Offset(1, 0).Select
ActiveSheet.Paste
Application.CutCopyMode = False
Worksheets("Activities").Activate
End If
End If
Next cellDim cell As Range
'Hides each row if Z >= "0"
For Each cell In Range("Z2:Z65536")
If cell.Value >= "0" Then
cell.Rows.Hidden = True
End If
Next cell
'selects columns
For Each cell In Range("Z2:Z65536")
If cell.Rows.Hidden = False Then
If cell.Value > "" Then
Range("H" & cell.Rows.Row & ":" & "O" & cell.Rows.Row & "," _
& "X" & cell.Rows.Row & ":" & "Y" & cell.Rows.Row).Select
'paste them to other sheet
Selection.Copy
Worksheets("Sheet2").Activate
Range("A65536").End(xlUp).Offset(1, 0).Select
ActiveSheet.Paste
Application.CutCopyMode = False
rng = Worksheets("Sheet2").Range("A65536").End(xlUp).Address
Worksheets("Activities").Activate
End If
End If
Next cell
 
G

GTVT06

I modified the code as below but its not doing what i want it to...

I added a few more columns that i want it to extract - i dont think i have
done it correctly!

Also, in the "sheet" where i want it to put this information i have stated
"report" but i would like for it to just put the information into a new sheet
because the "report" sheet may not always be there.. how do i do this?

thanks alot.

Sub tracker1()
Dim cell As Range
    'Hides each row if Z >= "0"
    For Each cell In Range("Z2:Z65536")
    If cell.Value > "0" Then
    cell.Rows.Hidden = True
    End If
    Next cell
    'selects columns
    For Each cell In Range("Z2:Z65536")
    If cell.Rows.Hidden = False Then
    If cell.Value > "" Then
    Range("C" & cell.Rows.Row & "D" & "G" & "H" & "T" & "U" & "V" & "W" &
"X" & cell.Rows.Row & "," _
    & "Y" & cell.Rows.Row & "Z" & "AM" & cell.Rows.Row).Select
    'paste them to other sheet
    Selection.Copy _
    Worksheets("Report").Range("A1")
    End If
    End If
    Next cell
End Sub








- Show quoted text -
Click to expand...

Here is the revised version with the revised Columns to copy.paste and
also the revisions for the "Report" sheet.

With Application
.DisplayAlerts = False
.EnableEvents = False
.ScreenUpdating = False
End With
Dim cell As Range
Dim n As Single
Dim exist As Boolean
For n = 1 To Sheets.Count
Sheets(n).Activate
If ActiveSheet.Name = "Report" Then
exist = True
End If
Next n
If exist = False Then
Sheets("Activities").Select
Sheets.Add
ActiveSheet.Name = "Report"
End If
Worksheets("Activities").Activate
'Hides each row if Z >= "0"
For Each cell In Range("Z2:Z65536")
If cell.Value >= "0" Then
cell.Rows.Hidden = True
End If
Next cell
'selects columns
For Each cell In Range("Z2:Z65536")
If cell.Rows.Hidden = False Then
If cell.Value > "" Then
Range("C" & cell.Rows.Row & ":" & "D" & cell.Rows.Row & "," _
& "G" & cell.Rows.Row & ":" & "H" & cell.Rows.Row & "," _
& "T" & cell.Rows.Row & ":" & "Z" & cell.Rows.Row & "," _
& "AM" & cell.Rows.Row & ":" & "AM" & cell.Rows.Row).Select
'paste them to other sheet
Selection.Copy
Worksheets("Report").Activate
If Range("A1") = "" Then
Range("A1").Select
ActiveSheet.Paste
Else
Range("A65536").End(xlUp).Offset(1, 0).Select
ActiveSheet.Paste
Application.CutCopyMode = False
End If
Worksheets("Activities").Activate
End If
End If
Next cell
With Application
.DisplayAlerts = True
.EnableEvents = True
.ScreenUpdating = True
End With
 
Z

Zak

I tried the code and it doesnt work! it went to error and highlighted:

"Worksheets("Activities").Activate", maybe because the "activities"
worksheet doesnt exist?

Also, i dont think you have put a code for 'if anything in column Z is
blank'..(additional to 'if anything is >0') how do i do that?

thanks for all your help.
 
G

GTVT06

I tried the code and it doesnt work! it went to error and highlighted:

"Worksheets("Activities").Activate", maybe because the "activities"
worksheet doesnt exist?

Also, i dont think you have put a code for 'if anything in column Z is
blank'..(additional to 'if anything is >0') how do i do that?

thanks for all your help.







- Show quoted text -
Click to expand...

Sorry Rename the Activites sheet to the appropriate name of the sheet
that has all of the data that we are copying from. Not sure what the
name is... And I'll modify to hide all blanks also, I forgot about
that
 
G

GTVT06

I tried the code and it doesnt work! it went to error and highlighted:

"Worksheets("Activities").Activate", maybe because the "activities"
worksheet doesnt exist?

Also, i dont think you have put a code for 'if anything in column Z is
blank'..(additional to 'if anything is >0') how do i do that?

thanks for all your help.
Click to expand...


Here you go. This will hide the blanks as well. Once again you'd have
to replace "Activities" to the actual sheet name of the sheet with the
source data.

With Application
.DisplayAlerts = False
.EnableEvents = False
.ScreenUpdating = False
End With
Dim cell As Range
Dim n As Single
Dim exist As Boolean
For n = 1 To Sheets.Count
Sheets(n).Activate
If ActiveSheet.Name = "Report" Then
exist = True
End If
Next n
If exist = False Then
Sheets("Activities").Select
Sheets.Add
ActiveSheet.Name = "Report"
End If
Worksheets("Activities").Activate
'Hides each row if Z >= "0"
For Each cell In Range("Z2:Z65536")
If cell.Value >= "0" Then
cell.Rows.Hidden = True
End If
Next cell
'Hide row if Column Z is blank
Dim lrow As Variant
lrow =
Worksheets("Activities").Range("Z65536").End(xlUp).Offset(1, 0).Row
Rows(lrow & ":65536").Hidden = True
'selects columns
For Each cell In Range("Z2:Z65536")
If cell.Rows.Hidden = False Then
If cell.Value > "" Then
Range("C" & cell.Rows.Row & ":" & "D" & cell.Rows.Row & "," _
& "G" & cell.Rows.Row & ":" & "H" & cell.Rows.Row & "," _
& "T" & cell.Rows.Row & ":" & "Z" & cell.Rows.Row & "," _
& "AM" & cell.Rows.Row & ":" & "AM" & cell.Rows.Row).Select
'paste them to other sheet
Selection.Copy
Worksheets("Report").Activate
If Range("A1") = "" Then
Range("A1").Select
ActiveSheet.Paste
Else
Range("A65536").End(xlUp).Offset(1, 0).Select
ActiveSheet.Paste
Application.CutCopyMode = False
End If
Worksheets("Activities").Activate
End If
End If
Next cell
With Application
.DisplayAlerts = True
.EnableEvents = True
.ScreenUpdating = True
End With
 
Z

Zak

Can anyone please reply to this as soon as you can, i really need to sort
this quickly for a presentation. i really hope you can get back to me asap.

thanks in advance.
 
G

GTVT06

Can anyone please reply to this as soon as you can, i really need to sort
this quickly for a presentation. i really hope you can get back to me asap..

thanks in advance.









- Show quoted text -
Click to expand...

Did you try my last suggestion?
 
Z

Zak

Yes, i tried the code you gave but it didnt work.

when i run the macro it runs but doesnt do anything, just skips to the last
sheet and one 1 occasion it highlighted 1 line in the code - the reason why
it doesnt work.

see my comments below,

please help!

thanks.
 
G

GTVT06

Yes, i tried the code you gave but it didnt work.

when i run the macro it runs but doesnt do anything, just skips to the last
sheet and one 1 occasion it highlighted 1 line in the code - the reason why
it doesnt work.

see my comments below,

please help!

thanks.






- Show quoted text -
Click to expand...

You have to change every instance of "Activities" to the approriate
sheet name of the sheet that contains the source data.
 
Z

Zak

I tried it again and changed all instances of "activities" to the appropriate
name and this time it highlights in red the following:

"Next cellDim cell As Range" - which appears somewhere in the middle.

sorry to keep bothering you, i just hope we can sort it quick.

thanks a lot.
 
G

GTVT06

I tried it again and changed all instances of "activities" to the appropriate
name and this time it highlights in red the following:

"Next cellDim cell As Range" - which appears somewhere in the middle.

sorry to keep bothering you, i just hope we can sort it quick.

thanks a lot.






- Show quoted text -
Click to expand...

looks like a string compile error. Maybe the message board didn't show
it in it's exact format?
The code below works perfectly on my end with no errors. If anything
highlights in red see if that command belongs on the next line down,
or if it's part of the string from the line above it, and adjust it
accordingly.

'Replace all instances of "Activities"
With Application
.DisplayAlerts = False
.EnableEvents = False
.ScreenUpdating = False
End With
Dim cell As Range
Dim n As Single
Dim exist As Boolean
For n = 1 To Sheets.Count
Sheets(n).Activate
If ActiveSheet.Name = "Report" Then
exist = True
End If
Next n
If exist = False Then
Sheets("Activities").Select
Sheets.Add
ActiveSheet.Name = "Report"
End If
Worksheets("Activities").Activate
'Hides each row if Z >= "0"
For Each cell In Range("Z2:Z65536")
If cell.Value >= "0" Then
cell.Rows.Hidden = True
End If
Next cell
'Hide row if Column Z is blank
Dim lrow As Variant
lrow =
Worksheets("Activities").Range("Z65536").End(xlUp).Offset(1, 0).Row
Rows(lrow & ":65536").Hidden = True
'selects columns
For Each cell In Range("Z2:Z65536")
If cell.Rows.Hidden = False Then
If cell.Value > "" Then
Range("C" & cell.Rows.Row & ":" & "D" & cell.Rows.Row & "," _
& "G" & cell.Rows.Row & ":" & "H" & cell.Rows.Row & "," _
& "T" & cell.Rows.Row & ":" & "Z" & cell.Rows.Row & "," _
& "AM" & cell.Rows.Row & ":" & "AM" & cell.Rows.Row).Select
'paste them to other sheet
Selection.Copy
Worksheets("Report").Activate
If Range("A1") = "" Then
Range("A1").Select
ActiveSheet.Paste
Else
Range("A65536").End(xlUp).Offset(1, 0).Select
ActiveSheet.Paste
Application.CutCopyMode = False
End If
Worksheets("Activities").Activate
End If
End If
Next cell
With Application
.DisplayAlerts = True
.EnableEvents = True
.ScreenUpdating = True
End With
 
Z

Zak

I changed all instances of activities to my source sheets name, ran the macro
and although i get no errror the macro runs but all it does is empties the
source sheet and doesnt do anything else.

i dont know what i am doing wrong, it is quite a big sheet..

what am i doing wrong?
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

Macro to run based on criteria 2
Copy specified columns to another sheet 8
macro to copy columns from one sheet to another sheet 4
VBA: How can I use a string variable as autofilter criteria? 4
Copying Range Based On Certain Criteria? Possible looping through the Range 1
query criteria based on a changing list of values 2
Deleting Values in a Row based on a Certain Criteria 2
copying data from one worksheet to several based on criteria 1

Top