jordansl
06-15-2015, 05:28 AM
In VBA for Excel 2013 - 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):
Master Sheet ====>Division Sheet
File No (A)====>File No (A)
Customer Code (B)====>Customer Code (B)
Customer Name (C)====>Customer Name (C)
Business Line (F)====>Business Line (D)
Date Invoiced (G)====>Date Invoiced (E)
Controller (H)====>Controller (F)
Loss (I)====>Loss (G)
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
IMPORTANT: If the File No. in the Master already exists in the Division sheet, then the macro should skip that line. However, if the File No. no longer exists in the Master, then that File No. should be removed from the division sheet.
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.
Lastly, I inserted the new data one row above the bottom so that all formatting would be maintained - if there's a better way to do this please let me know!
Thanks for your help!
Master Sheet ====>Division Sheet
File No (A)====>File No (A)
Customer Code (B)====>Customer Code (B)
Customer Name (C)====>Customer Name (C)
Business Line (F)====>Business Line (D)
Date Invoiced (G)====>Date Invoiced (E)
Controller (H)====>Controller (F)
Loss (I)====>Loss (G)
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
IMPORTANT: If the File No. in the Master already exists in the Division sheet, then the macro should skip that line. However, if the File No. no longer exists in the Master, then that File No. should be removed from the division sheet.
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.
Lastly, I inserted the new data one row above the bottom so that all formatting would be maintained - if there's a better way to do this please let me know!
Thanks for your help!