Copying noncontiguous ranges pasting to a contiguous range

[Xceller]

I am trying copy 10 ranges from an Input Sheet and past them to a Database list format sheet. The problem is that there are 3 sub-total rows in Worksheet("Input"), row 21,21 and 23, but the code below copies these 3 row to Worksheet("dBASE"). Any help is greatly appreciated.


Sub copyNpaste()

Dim WSI As Worksheet
Dim WSD As Worksheet

Set WSI = Worksheets("Input")
Set WSD = Worksheets("dBASE")


WSI.Range("C14:C20", "C24:C30").Value = WSD.Cells(FinalRow + 1, 1)
WSI.Range("O14:O20", "O24:O30").Value = WSD.Cells(FinalRow + 1, 2)
WSI.Range("S14:S20", "S24:S30").Value = WSD.Cells(FinalRow + 1, 3)
WSI.Range("T14:T20", "T24:T30").Value = WSD.Cells(FinalRow + 1, 4)
WSI.Range("U14:T20", "U24:T30").Value = WSD.Cells(FinalRow + 1, 5)

End Sub()

 

[Xceller]

Thanks Andrew. It works now. What does Set do, and why it works now?

 

[Andrew Poulsom]

Set is required to assign an object to a variable.

 

[Xceller]

Thanks Andrew. If I place the code here in red, it works:
Sub copyNpaste1()

Dim WSI As Worksheet
Dim WSD As Worksheet


Set WSI = Worksheets("Input")
Set WSD = Worksheets("dBASE")


FinalRow = Sheets("dBASE").Cells(Rows.Count, 1).End(xlUp).Row
Set dRange = Sheets("dBASE").Range("A2").Resize(FinalRow - 1, 1)
CurrentDate = Sheets("Input").Range("E5").Value


If Not dRange.Find(CurrentDate) Is Nothing Then
MsgBox "Data already exist"
Exit Sub
Else


WSD.Cells(FinalRow + 1, 1).Resize(7, 1).Value = WSI.Range("C14:C20").Value
WSD.Cells(FinalRow + 8, 1).Resize(7, 1).Value = WSI.Range("C24:C30").Value

WSD.Cells(FinalRow + 1, 2).Resize(7, 1).Value = WSI.Range("O14:O20").Value
WSD.Cells(FinalRow + 8, 2).Resize(7, 1).Value = WSI.Range("O24:O30").Value

WSD.Cells(FinalRow + 1, 3).Resize(7, 1).Value = WSI.Range("S14:S20").Value
WSD.Cells(FinalRow + 8, 3).Resize(7, 1).Value = WSI.Range("S24:S30").Value

WSD.Cells(FinalRow + 1, 4).Resize(7, 1).Value = WSI.Range("T14:T20").Value
WSD.Cells(FinalRow + 8, 4).Resize(7, 1).Value = WSI.Range("T24:T30").Value

WSD.Cells(FinalRow + 1, 5).Resize(7, 1).Value = WSI.Range("U14:U20").Value
WSD.Cells(FinalRow + 8, 5).Resize(7, 1).Value = WSI.Range("U24:U30").Value
End If
End Sub]

But if I place the Set here then it doesn't work:

[Sub copyNpaste1()

Dim WSI As Worksheet
Dim WSD As Worksheet


Set WSI = Worksheets("Input")
Set WSD = Worksheets("dBASE")
Set dRange = Sheets("dBASE").Range("A2").Resize(FinalRow - 1, 1)

FinalRow = Sheets("dBASE").Cells(Rows.Count, 1).End(xlUp).Row

CurrentDate = Sheets("Input").Range("E5").Value


If Not dRange.Find(CurrentDate) Is Nothing Then
MsgBox "Data already exist"
Exit Sub
Else


WSD.Cells(FinalRow + 1, 1).Resize(7, 1).Value = WSI.Range("C14:C20").Value
WSD.Cells(FinalRow + 8, 1).Resize(7, 1).Value = WSI.Range("C24:C30").Value

WSD.Cells(FinalRow + 1, 2).Resize(7, 1).Value = WSI.Range("O14:O20").Value
WSD.Cells(FinalRow + 8, 2).Resize(7, 1).Value = WSI.Range("O24:O30").Value

WSD.Cells(FinalRow + 1, 3).Resize(7, 1).Value = WSI.Range("S14:S20").Value
WSD.Cells(FinalRow + 8, 3).Resize(7, 1).Value = WSI.Range("S24:S30").Value

WSD.Cells(FinalRow + 1, 4).Resize(7, 1).Value = WSI.Range("T14:T20").Value
WSD.Cells(FinalRow + 8, 4).Resize(7, 1).Value = WSI.Range("T24:T30").Value

WSD.Cells(FinalRow + 1, 5).Resize(7, 1).Value = WSI.Range("U14:U20").Value
WSD.Cells(FinalRow + 8, 5).Resize(7, 1).Value = WSI.Range("U24:U30").Value
End If
End Sub

 

[AlphaFrog]

Look at what FinalRow is doing in both cases...

Set dRange = Sheets("dBASE").Range("A2").Resize(FinalRow - 1, 1)

It matters when you define FinalRow; before or after you Set dRange?

 

[Andrew Poulsom]

Before!

 

[Xceller]

Got it. Really appreciate your help!

Since new(most current) data(dates) get added to the database list, so the most current data is always at the bottom of the list (i.e. Range("A2:A1000000")). If I am doing a match, instead of searching through 1,000,000 records to find a match, can I start the matching process from the bottom up?

I try go from bottom up by doing this, but it doesn't work. Is it because negative numbers are not allowed when using Resize?

Cells(FinalRow,1).Resize(1-FinalRow,1)

 

[AlphaFrog]

This will search dRange from the bottom up...

If Not dRange.Find(CurrentDate, [COLOR="Red"]SearchDirection:=xlPrevious[/COLOR]) Is Nothing Then

 

[Xceller]

Thank you so much for your help!

 

[Xceller]

Something else just came to mind. What if Sheets("dBBASE") gets filled (1048576), then everything is out of wrack?
FinalRow is wrong

I will probably have to add a new sheet and rename all the variables. Could this be done automatically?

 

[AlphaFrog]

Change your code to the red text below. Then when dBase is full, you only have to change the one dBase name (blue) to the new dBase sheet name.

Set WSD = Worksheets("[COLOR="Blue"]dBASE[/COLOR]")

FinalRow = [COLOR="Red"]WSD.[/COLOR]Cells(Rows.Count, 1).End(xlUp).Row
Set dRange = [COLOR="Red"]WSD.[/COLOR]Range("A2").Resize(FinalRow - 1, 1)