jordansl
05-29-2015, 06:48 AM
I need to tailor which data is copied and pasted to the division sheets. An example of the data is attached - the data that goes into the Division sheets is as follows (with columns of Master sheet noted):
File Number (A) | Customer Code (B) | Customer Name (C) | Business Line (F) | Date Invoiced (G) | Controller (H) | Loss (I)
Basically I need to leave out columns D, E, and J as the order of the columns remains the same. The comments column of each division sheet is manually filled in by users.
Here is the full macro (that the incomparable SamT helped me write):
Sub UpdateDivisionsSyr()
'Update division worksheets with new data (do NOT delete old)
Dim ShtMaster As Worksheet
Dim ShtDivision As String
Dim divIDMaster As Range
Dim rowIDDivision As Range
Dim rowID 'As Variant because I don't know it
Dim Cel As Range
Dim Found As Range
Dim LastRow As Long
Set ShtMaster = Worksheets("Master")
With ShtMaster
LastRow = .Cells(Rows.Count, 1).End(xlUp).Row
Set divIDMaster = .Range("D5:D" & CStr(LastRow))
End With
For Each Cel In divIDMaster
Select Case Cel.Value
Case 10
ShtDivision = "SYR"
rowID = Cel.Offset(0, -3)
Case 20
ShtDivision = "ROC"
rowID = Cel.Offset(0, -3)
Case 30
ShtDivision = "ALB"
rowID = Cel.Offset(0, -3)
Case 40
ShtDivision = "BUF"
rowID = Cel.Offset(0, -3)
Case 50
ShtDivision = "CLE"
rowID = Cel.Offset(0, -3)
Case 60
ShtDivision = "ORD"
rowID = Cel.Offset(0, -3)
Case Else
MsgBox "Error - Division not found" 'Error handling
End Select
Cel.EntireRow.Copy 'to "PasteSpecial" below
With Sheets(ShtDivision)
LastRow = .Cells(Rows.Count, 1).End(xlUp).Row
Set rowIDDivision = .Range("A5:A" & CStr(LastRow))
Set Found = rowIDDivision.Find(rowID)
If Found Is Nothing Then .Rows(LastRow).Insert Shift:=xlDown
End With
Next Cel
End Sub
I'm trying to set up a Union to pull the range I need out of the row that Cel exists in, here is what I have to replace Cel.EntireRow.Copy:
Dim PasteData as Range, rng1 As Range, rng2 As Range
Set rng1 = .Range(Cel.Offset(0,-3),Cel.Offset(0,-1)) 'This selects columns A through C of the current row
Set rng2 = .Range(Cel.Offset(0,2),Cel.Offset(0,5)) 'This selects columns F through I of the current row
Set PasteData = Union(rng1,rng2) 'This selects both ranges and puts them together
Application.PasteData.Copy
When I ran this the first time, it looked like it worked (ie no errors) but going through the worksheets I saw that only the first line of data for each division sheet had been copied, then extra blank lines appeared below it. It looked like the macro knew how many rows needed to be inserted, but the data didn't go in at all. Since then I've tried to tweak it to work but I only get errors and the macro will not run.
I think "If Found Is Nothing Then .Rows(LastRow).Insert Shift:=xlDown" is also giving me some trouble but I haven't been able to pinpoint the source yet.
Thanks for your help!
File Number (A) | Customer Code (B) | Customer Name (C) | Business Line (F) | Date Invoiced (G) | Controller (H) | Loss (I)
Basically I need to leave out columns D, E, and J as the order of the columns remains the same. The comments column of each division sheet is manually filled in by users.
Here is the full macro (that the incomparable SamT helped me write):
Sub UpdateDivisionsSyr()
'Update division worksheets with new data (do NOT delete old)
Dim ShtMaster As Worksheet
Dim ShtDivision As String
Dim divIDMaster As Range
Dim rowIDDivision As Range
Dim rowID 'As Variant because I don't know it
Dim Cel As Range
Dim Found As Range
Dim LastRow As Long
Set ShtMaster = Worksheets("Master")
With ShtMaster
LastRow = .Cells(Rows.Count, 1).End(xlUp).Row
Set divIDMaster = .Range("D5:D" & CStr(LastRow))
End With
For Each Cel In divIDMaster
Select Case Cel.Value
Case 10
ShtDivision = "SYR"
rowID = Cel.Offset(0, -3)
Case 20
ShtDivision = "ROC"
rowID = Cel.Offset(0, -3)
Case 30
ShtDivision = "ALB"
rowID = Cel.Offset(0, -3)
Case 40
ShtDivision = "BUF"
rowID = Cel.Offset(0, -3)
Case 50
ShtDivision = "CLE"
rowID = Cel.Offset(0, -3)
Case 60
ShtDivision = "ORD"
rowID = Cel.Offset(0, -3)
Case Else
MsgBox "Error - Division not found" 'Error handling
End Select
Cel.EntireRow.Copy 'to "PasteSpecial" below
With Sheets(ShtDivision)
LastRow = .Cells(Rows.Count, 1).End(xlUp).Row
Set rowIDDivision = .Range("A5:A" & CStr(LastRow))
Set Found = rowIDDivision.Find(rowID)
If Found Is Nothing Then .Rows(LastRow).Insert Shift:=xlDown
End With
Next Cel
End Sub
I'm trying to set up a Union to pull the range I need out of the row that Cel exists in, here is what I have to replace Cel.EntireRow.Copy:
Dim PasteData as Range, rng1 As Range, rng2 As Range
Set rng1 = .Range(Cel.Offset(0,-3),Cel.Offset(0,-1)) 'This selects columns A through C of the current row
Set rng2 = .Range(Cel.Offset(0,2),Cel.Offset(0,5)) 'This selects columns F through I of the current row
Set PasteData = Union(rng1,rng2) 'This selects both ranges and puts them together
Application.PasteData.Copy
When I ran this the first time, it looked like it worked (ie no errors) but going through the worksheets I saw that only the first line of data for each division sheet had been copied, then extra blank lines appeared below it. It looked like the macro knew how many rows needed to be inserted, but the data didn't go in at all. Since then I've tried to tweak it to work but I only get errors and the macro will not run.
I think "If Found Is Nothing Then .Rows(LastRow).Insert Shift:=xlDown" is also giving me some trouble but I haven't been able to pinpoint the source yet.
Thanks for your help!