Macro to loop through data in Master Worksheet

[jordansl]

hi - I'm currently working on a simple macro in an Excel workbook. The main part of the macro pulls in data from a SQL stored procedure and formats it into a Master worksheet. I am now trying to extract data from this Master sheet and append it to other worksheets that are broken out by office location. I need to find rows that have a certain indicator in Column D - this denotes which office location the data belongs to. Once the macro finds a row of data with the correct office location, it needs to compare the row ID (column A) to the row columns of the office worksheet - if the row ID already exists, nothing happens. If the row ID does NOT exist, then the row must be copied from the Master sheet into the Office sheet.

In a nutshell: I need to loop through entries in the Master sheet based on a value in a certain column. For all entries that match my value, I need to compare each entry to another worksheet to see if the entry already exists. If it does, no changes, if it does not, copy the row and paste it into the worksheet (it is not deleted from the Master sheet).

Here is what I have so far (in this example, "10" is the office location ID):

Sub UpdateDivisionsSyr()
'Update division worksheets with new data (do NOT delete old)
Dim rowIDM As Range, rowIDS As Range, i As Integer
Dim Master, DivisionSyr


Set Master = Worksheets("Master")
Set DivisionSyr = Worksheets("SYR")



For Each rowIDM In Master.Range(Master.Range("A:A"), Master.Cells(Rows.Count, 1).End(xlUp)).Cells


i = 1
If Cells(i, 4).Value = "10" And Not IsEmpty(Cells(i, 1).Value) Then

Set rowIDS = DivisionSyr.Range(DivisionSyr.Range("A:A"), _
DivisionSyr.Cells(Rows.Count, 1).End(xlUp)).Find( _
What:=rowIDM.Value, lookat:=xlWhole)


If rowIDS Is Nothing Then
DivisionSyr.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Resize(Master, SYR).Value = _
rowIDM.Resize(Master, SYR).Value
End If
End If
Next rowIDM

End Sub

[SamT]

Jordan,

First let me welcome you to VBAX Express, IMO, simply the best site for all Microsoft Office help.

I am having to make some assumption about what exactly you need. I am going to make up some sheet names based on a major Building Contractors business.

See how this works for you.

Option Explicit

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).Row
        Set divIDMaster = .Range("D:D" & CStr(LastRow))
      End With
     
     
    For Each Cel In divIDMaster
      Select Case Cel.Value
        Case 10
          ShtDivision = "SYR"
          rowID = Cel.Offset(0, -4)
        Case 11
          ShtDivision = "Estimating" 'note copy paste edit number & name
          rowID = Cel.Offset(0, -4)
        Case 13
          ShtDivision = "Superintendents"
          rowID = Cel.Offset(0, -4)
        Case Else
          MsgBox "Oopsies. Sumtin bad happen to me" 'Cheap error handling
      End Select
      
      Cel.EntireRow.Copy 'to "PasteSpecial" below
         
      With Sheets(ShtDivision)
         LastRow = .Cells(Rows.Count, 1).Row
        Set rowIDDivision = .Range("A:A" & CStr(LastRow))
        
        Set Found = rowIDDivision.Find(rowID)
        If Found Is Nothing Then .Rows(LastRow + 1).PasteSpecial
      End With
    Next Cel
       
End Sub

[jordansl]

Thanks for your quick feedback! I understand how you set up the macro, but I am getting an error upon running it: "Run-time error '1004': Method 'Range' of object '_Worksheet' failed.

When I debug the error, it points me to the below highlighted code:

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).Row
Set divIDMaster = .Range("D:D" & CStr(LastRow))
End With

Could this error be occurring because this is called from a larger macro? (see below snippet):

ActiveSheet.Range("Master[#All]").RemoveDuplicates Columns:=Array(1, 2, 3, 4, 5, 6 _
, 7, 8, 9, 10), Header:=xlYes
'Delete Master table data where Loss equals zero or more
DeleteGreaterThanZero
'Update division sheets with Master data
UpdateDivisionsSyr

The DeleteGreaterThanZero sub ends with Range("A5").Select, FYI.


Also, you included a note that said: "Dim rowID 'Variant because I don't know it" Do you need further information from me? The tabs I need to move the data into are named by text (ie. SYR, ALB, etc) but the Division number that I use to match them is (obv) a number (ie SYR = 10). Below is what I changed the code to, will it still work IYO?:
For Each Cel In divIDMaster
Select Case Cel.Value
Case 10
ShtDivision = "SYR"
rowID = Cel.Offset(0, -4)
Case 20
ShtDivision = "ROC" 'note copy paste edit number & name
rowID = Cel.Offset(0, -4)
Case 30
ShtDivision = "ALB"
rowID = Cel.Offset(0, -4)
Case 40
ShtDivision = "BUF"
rowID = Cel.Offset(0, -4)
Case 50
ShtDivision = "CLE"
rowID = Cel.Offset(0, -4)
Case 60
ShtDivision = "ORD"
rowID = Cel.Offset(0, -4)
Case Else
MsgBox "Error - Division not found" 'Error handling
End Select



Thanks again!!

[SamT]

Set divIDMaster = .Range("D" & CStr(LastRow))

The error is a typo in the Range address
It should have a row number after the first Column letter, ie Range("D5" & CStr(LastRow))

REally stragne, I nevre make tpyos.

[jordansl]

(haha took me a second to get it)

Ok, now it stops at the below with the message: "Cel.Offset(0,4) = <Application-defined or object-defined error>"

For Each Cel In divIDMaster
Select Case Cel.Value
Case 10
ShtDivision = "SYR"
rowID = Cel.Offset(0, -4)
Case 20
ShtDivision = "ROC" 'note copy paste edit number & name
rowID = Cel.Offset(0, -4)
Case 30
ShtDivision = "ALB"
rowID = Cel.Offset(0, -4)
Case 40
ShtDivision = "BUF"
rowID = Cel.Offset(0, -4)

I don't think I understand why it would pass through the three examples before that with no problem and then get stuck. I checked the data and there's nothing screwy going on there.

Also, will I run into the same typo problem later in the macro when it gets to the below towards the end?:
Set rowIDDivision = .Range("A:A" & CStr(LastRow))

[SamT]

Yeah, I forgot to turn off smilies for that post.

In rowID = Cel.Offset(0, -4), is that an upper case eye or a lower case ell?

Also, will I run into the same typo problem later in the macro when it gets to the below towards the end?:
Set rowIDDivision = .Range("A??:A" & CStr(LastRow))

Absolutely!

       With Sheets(ShtDivision)
            LastRow = .Cells(Rows.Count, 1).Row
            Set rowIDDivision = .Range("A5:A" & CStr(LastRow)) 'Edit A5 to suit
             
            Set Found = rowIDDivision.Find(rowID)
            If Found Is Nothing Then .Rows(LastRow + 1).PasteSpecial
        End With

I'm physically exhausted and my brains is very physical. I needs my nap.

[jordansl]

It is an uppercase eye - I copied and pasted from the rows above it so I'm not sure where the issue lies. I just tried retyping that whole section and saving just in case, but the debugger still highlights that same row. How weird is that?

[SamT]

CAn You strip out all personal, proprietary, and confidential data and share a workbook with three lines of data in it. It will only need the sheets referenced in the data + "BUF"

[jordansl]

ForSamT.xlsx

Hi there - attached! Let me know if you need further information. Below is the entire macro thusfar:

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).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, -4)
Case 20
ShtDivision = "ROC"
rowID = Cel.Offset(0, -4)
Case 30
ShtDivision = "ALB"
rowID = Cel.Offset(0, -4)
Case 40
ShtDivision = "BUF"
rowID = Cel.Offset(0, -4)
Case 50
ShtDivision = "CLE"
rowID = Cel.Offset(0, -4)
Case 60
ShtDivision = "ORD"
rowID = Cel.Offset(0, -4)
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).Row
Set rowIDDivision = .Range("A5:A" & CStr(LastRow))

Set Found = rowIDDivision.Find(rowID)
If Found Is Nothing Then .Rows(LastRow + 1).PasteSpecial
End With
Next Cel

End Sub

[SamT]

Uh... That's not the code you are using. That is the code as I gave it to you. At the very least, you would need to change the offset to rowID to (0,-3)

I fixed the Offset to (0, -3) and have duplicated the "BUF" Error. I had an Omission in the LastRow parts, first and second. Several other errors showed up as I fixed each one.

I think this works.

Option Explicit

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

'Select division Sheet to work on. Edit Case values to suit
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
  
  'Copy the Row
  Cel.EntireRow.Copy 'to "PasteSpecial" below
  
  'Working on the selected Division sheet
  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 + 1).PasteSpecial
  End With
Next Cel

End Sub

[jordansl]

Ok. So anyway, the code works great!

My next task would be to tailor which data is copied and pasted to the division sheets. As you can see from the example I sent you, 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 just 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.

I think I would need to modify this part of the existing code to do this:
Set Found = rowIDDivision.Find(rowID)
If Found Is Nothing Then .Rows(LastRow + 1).PasteSpecial

Instead of .Rows, can I change this to use an Offset code like in the division CASE part? Or something like the below? I know the hardcoded references won't work in an viable solution...

Eg:
Dim DivMove As Range
.
.
.
Set DimMove = .Range("A15,B15,C15,F15,G15,H15,I15").Select
If Found Is Nothing Then .Rows(LastRow + 1).PasteSpecial

Lastly, I would like to be able to copy the formatting down to all new rows as they are pasted into the sheets.


Thanks so much for all your help!