Solved: Popular topic -- copy data to empty rows, NOT

[joelle]

Dear Experts,
I saw posts on this subject but they are difficult and dont
match my simple case, that only involves the popular topic of copy
and paste selected rows to the next empty rows on a different ws, but
shallow-bie as myself cant figure this out!

I have 3 ws: NUM1, OUTPUT, NUM2.
What I try to do is:

0. sheet "output" will always have some rows there with data
1. code to go to sheet NUM1, select lines 8-100 and paste them
to the second next empty rows in the sheet "output"
2. code will check for any line in sheet "output" that has the word
"Grand Total" under column C and copy the entire rows to rows starting
with row 4 in sheet NUM2.
3. then, copy row 8 from NUM2 back to the "second" next empty row on
sheet "output"

As you can see, it is all about copy selected rows to the next empty rows.
I bow in advance to any help!!

Nee

[lucas]

1. code to go to sheet NUM1, select lines 8-100 and paste them
to the second next empty rows in the sheet "output"

Does this mean to leave a row blank in the output sheet...?
between the existing data on the output sheet and the copied data?

[lucas]

This should do Number 1 for you....
[VBA]
Sub Macro2()
Dim RgDestination As Range
Dim rg As Range
Set RgDestination = Sheets("output").Range("A65536") _
.End(xlUp).Offset(2, 0).EntireRow

Set rg = Sheets("Num1").Rows("8:100")
If Not rg Is Nothing Then
rg.EntireRow.Copy RgDestination
End If
End Sub
[/VBA]

[joelle]

Hello Steve,
Thanks for jumping to my rescue!

I tried the codes for step 1, but only 2 lines from num1 are copied over to
the 2nd next empty rows in "output" -- it actually has to copy as many lines
from num1, though it does not have to be exactly 800 lines.

And your code said to do step 1 for me ... but where can I go without steps 2 and 3.
pls dont leave me hanging. I have bought a whole VBA cd from Walkenbach but so
shallow to draw any clue from it. [sad]


Please help me.
Nee

[joelle]

Steve,
I took another look at the code you donated and found the reason I couldnt make it work is I have filter in ws "num1" (data rows are not continuous) I fixed num1 to not have any filter. And the code for step 1 work beautifully.

Now I stick my neck out awaiting SOS on steps 2 and 3.


Nee

[mdmackillop]

Adding to Steve's code

BTW, you may not want or need the Paste Specials.
[vba]
Option Explicit

Sub DoCopies()
Copy1
Copy2
Copy3
End Sub

Sub Copy1()
Dim RgDestination As Range
Dim rg As Range
Set RgDestination = Sheets("output").Range("A65536") _
.End(xlUp).Offset(2)
Set rg = Sheets("Num1").Rows("8:100")
If Not rg Is Nothing Then
rg.EntireRow.Copy RgDestination
End If
End Sub

Sub Copy2()
Dim Rw As Long, Tgt As Range, c As Range
Dim FirstAddress As String
'Set destination
With Sheets("Num2")
Rw = .Cells(Rows.Count, "A").End(xlUp).Row
If Rw = 1 Then Rw = 4
Set Tgt = .Cells(Rw, 1)
End With
'Find Grand Totals and copy
With Worksheets("Output").Columns(3)
Set c = .Find("Grand Total")
If Not c Is Nothing Then
FirstAddress = c.Address
Do
'c.EntireRow.Copy Tgt
'or
c.EntireRow.Copy
Tgt.PasteSpecial xlPasteValues

Set Tgt = Tgt.Offset(1)
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address <> FirstAddress
End If
End With
Set Tgt = Nothing
End Sub

Sub Copy3()
'For testing
Sheets("Num2").Rows(8).Interior.ColorIndex = 22

Sheets("Num2").Rows(8).Copy Sheets("Output").Cells(Rows.Count, "A").End(xlUp).Offset(2)
Application.CutCopyMode = False
End Sub
[/vba]

[joelle]

Hello MdMckillop,

There are many times already that I received your help!
Thank you for the detailed codes -- however, I have a mother SUB.
How do I Sir run the set of codes from inside my sub. Other words, is
there a way to NOT use "option explicit" and insert your codes into an existing SUB ?

Many thanks,
Nee

[mdmackillop]

You only use option explicit once on each sheet, so if it is already there that's OK.
To run this from inside another sub, just paste the three lines,
Copy1
Copy2
Copy3
into your sub at the appropriate point, then paste the three subs after it.

[joelle]

Sir,
I'm so excited and am trying them right now (a long way to go for a shallowie like me). Will post back.
Many thanks,
Nee

[joelle]

Dear Mdmckillop,
I worked several hours on the codes you provided and tried to make them work with mine but I'm stuck with Sub Copy2 ()
--------------------------------------------------
I then simplified my sub to use only 2 worksheets instead of 3. The 2 ws are: num1 and output.
Code as shown below and I need some help with a gap of codes there to make this sub complete. So far Sub Copy 1 works beautifully ...
I also attach a screen because I dont know how to attach my ws.
Pls bear with me and again you (and other experts) save my trouble day if I can get some code for the gap in my sub as shown:

[vba]Sub abcprice()

' this section1 is my own macro that does the filter
Range("A10").Select
ActiveCell.FormulaR1C1 = "=ABCpricing!R[34]C[8]"
Range("B10").Select
ActiveCell.FormulaR1C1 = "=ABCpricing!R[34]C[-1]"
Range("C10").Select
ActiveCell.FormulaR1C1 = "=ABCpricing!R[34]C[-1]"
Selection.Copy
Range("A11:F1300").Select
ActiveSheet.Paste
Range("A9").Select
Selection.AutoFilter
Selection.AutoFilter Field:=1, Criteria1:=">0", Operator:=xlOr, _
Criteria2:="=>"

'This part does the Copy1() sub you gave. Works great!!!
Sheets("output").Select
Dim RgDestination As Range
Dim rg As Range
Set RgDestination = Sheets("output").Range("A65536") _
.End(xlUp).Offset(2, 0).EntireRow

Set rg = Sheets("num1").Rows("11:1000")
If Not rg Is Nothing Then
rg.EntireRow.Copy RgDestination
End If


'The gap is here. At this point, I need HELP (codes) to:
'1. Locate the next empty row in ws "quote"
'2. Enter the word "Final grand total" in cell C of the empty row
found in step 1
'3. Locate any lines in the active ws (quote) that has the word "grand total"
'3b. Add the 2 grand totals found in step #3 to cells E and F of the
'final grand total line created in steps 1 & 2

' here is some more code of mine

End Sub[/vba]
Many thanks!
Nee

[mdmackillop]

Hi Nee,
To attach a workbook, use Manage Attachments in the Go Advanced section
Regards
Malcolm

[mdmackillop]

Hi Nee,
There may be a problem with capital letters. Try adding "Option Compare Text" in the line below Option Explicit. This tells the routine to ignore capitals so that GRAND TOTAL and Grand Total are both found by a search.
Regards
Malcolm

[joelle]

Hello Mdmckillop,
I have cleaned and modified the sub. Please could you help me with the gap in the modified sub below as you can see that it is much cleaner than how I planned for it before, and, I now only deal with 2 worksheets for this vba. Very appreciate your extended help here !!!
I attach my WS below.

[VBA]Sub abcprice()

' this section1 is my own macro that does the filter
Range("A10").Select
ActiveCell.FormulaR1C1 = "=ABCpricing!R[34]C[8]"
Range("B10").Select
ActiveCell.FormulaR1C1 = "=ABCpricing!R[34]C[-1]"
Range("C10").Select
ActiveCell.FormulaR1C1 = "=ABCpricing!R[34]C[-1]"
Selection.Copy
Range("A11:F1300").Select
ActiveSheet.Paste
Range("A9").Select
Selection.AutoFilter
Selection.AutoFilter Field:=1, Criteria1:=">0", Operator:=xlOr, _
Criteria2:="=>"

'This part does the Copy1() sub you gave. Works great!!!
Sheets("output").Select
Dim RgDestination As Range
Dim rg As Range
Set RgDestination = Sheets("output").Range("A65536") _
.End(xlUp).Offset(2, 0).EntireRow

Set rg = Sheets("num1").Rows("11:1000")
If Not rg Is Nothing Then
rg.EntireRow.Copy RgDestination
End If


'The gap is here. At this point, I need HELP (codes) to:
'1. Locate the next empty row in ws "output"
'2. Enter the word "Final grand total" in cell C of the empty row
found In Step 1
'3. Locate any lines in the active ws (output) that has the word "grand total"
'3b. Add the 2 grand totals found in step #3 to cells E and F of the
'final grand total line created in steps 1 & 2

' and some more code of mine

End Sub[/VBA]

So, I'm almost there. Still awaiting help please !!!

Nee

[mdmackillop]

Hi Nee.
Do you not find that your column A fills with #Ref! cells when you run your filter? With regard to this section of the code. It's not necessary to select the cells you wish to change. The following should do the same job
[VBA]
Range("A10").FormulaR1C1 = "=ABCpricing!R[34]C[8]"
Range("B10").FormulaR1C1 = "=ABCpricing!R[34]C[-1]"
Range("C10").FormulaR1C1 = "=ABCpricing!R[34]C[-1]"
Range("C10").Copy Range("A11:F1300")
Range("A9").AutoFilter Field:=1, Criteria1:=">0", Operator:=xlOr, _
Criteria2:="=>"

[/VBA]
This bit should fill in "the Gap"
[VBA]
Option Explicit
Option Compare Text
Sub Totals()
Dim Tgt As Range, c As Range, SearchRange As Range
Dim FirstAddress As String
Dim EP As String
'Start the formula for totals
EP = "="

'Find cell for final total
Set Tgt = Sheets("quote").Cells(Rows.Count, 3).End(xlUp).Offset(2)
'Find cells containing Grand Total; add the corresponding address into the formula
Set SearchRange = Sheets("quote").Range(Cells(1, 3), Tgt.Offset(-1))
With SearchRange
Set c = .Find(What:="Grand Total", lookat:=xlPart, after:=Cells(1, 3))
If Not c Is Nothing Then
FirstAddress = c.Address
Do
'Add the address to the formula
EP = EP & c.Offset(, 2).Address(0, 0) & "+"
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address <> FirstAddress
End If
End With
'Remove the final plus sign
EP = Left(EP, Len(EP) - 1)
'Write in the text
Tgt = "FINAL GRAND TOTAL"
'Write in the formula
Tgt.Offset(, 2).Formula = EP
'Copy to the next column
Tgt.Offset(, 2).Resize(, 2).FillRight
'Copy formatting
c.Copy
Tgt.PasteSpecial Paste:=xlFormats
c.Offset(, 2).Copy
Tgt.Offset(, 2).Resize(, 2).PasteSpecial Paste:=xlFormats
Application.CutCopyMode = False
End Sub
[/VBA]

[joelle]

Hello MdMckillop,

It is Friday afternoon and you've saved me BIG! with your backtoback postings
and detailed codes. You did help and care about smaller doggies!

Yes, your codes work gracefully. And your own time working to help others with their trouble codes is not taken for granted. It means a lot to people you helped and to a swallowie like me that goes around around asking for help. Do I sound like trying to flatter you? No. Your many posts/helping codes have proven that you deverse a promotion very soon. (hope my opinion HEARD!!!)


Thank you Sir.
Nee