Excel - Missing rows inquiry

JDeMaro22
StarLounger
Posts: 94
Joined: 16 Oct 2021, 16:22

Excel - Missing rows inquiry

Post by JDeMaro22 »

Hi everyone,

I am looking for a macro or formula that will add additional rows onto multiple other existing sheets. Sheet 1(CorpDepts Corporate Department) has all the row items that need to be shown on all the additional sheets. Basically the CFO needs each of the worksheets to show the exact same expenses even if they do not hold any values. There are over 40 worksheets and I'm not sure what the best practice would be. I would be happy if just the missing rows were placed in each worksheet then I could just sort them to match the format. I have attached a sample worksheet w/ the values removed.

It will not allow me to use a link to my file, any help on that as well for reference would be great.

Please let me know if you have any suggestions,

Thank you,

Joshua

User avatar
HansV
Administrator
Posts: 78241
Joined: 16 Jan 2010, 00:14
Status: Microsoft MVP
Location: Wageningen, The Netherlands

Re: Excel - Missing rows inquiry

Post by HansV »

Welcome to Eileen's Lounge!

As long as the sample workbook is below 256 KB, you can attach it to a reply. If necessary, click "Fill Editor & Preview" below the reply area, then simply drag and drop the file into the reply area.
Best wishes,
Hans

JDeMaro22
StarLounger
Posts: 94
Joined: 16 Oct 2021, 16:22

Re: Excel - Missing rows inquiry

Post by JDeMaro22 »

Thanks HansV,


I've attached the file
You do not have the required permissions to view the files attached to this post.

User avatar
HansV
Administrator
Posts: 78241
Joined: 16 Jan 2010, 00:14
Status: Microsoft MVP
Location: Wageningen, The Netherlands

Re: Excel - Missing rows inquiry

Post by HansV »

Here is a macro. It will take some time to run because there is a lot of checking to do.

Code: Select all

Sub AddRows()
    Dim wS As Worksheet
    Dim wT As Worksheet
    Dim s As Long
    Dim t As Long
    Dim m As Long
    Dim n As Long
    Dim a As String
    Dim b As String
    Dim c As Range
    Application.ScreenUpdating = False
    ' First sheet
    Set wS = Worksheets("CorpDepts Corporate Department")
    ' Get last used row
    m = wS.Range("A" & wS.Rows.Count).End(xlUp).Row
    ' Loop through the sheets
    For Each wT In Worksheets
        ' Skip the first one
        If wT.Name <> wS.Name Then
            ' Get last used row
            n = wT.Range("A" & wT.Rows.Count).End(xlUp).Row
            ' Loop through the rows of column A of the first sheet
            For s = 11 To m
                ' Get the cell value
                a = wS.Range("A" & s).Value
                ' Do we have an account?
                If Left(a, 1) = "(" Then
                    ' Can we find it in column A on the other sheet?
                    Set c = wT.Range("A11:A" & n).Find(What:=a, LookAt:=xlWhole)
                    ' If not
                    If c Is Nothing Then
                        ' Loop through the rows of column A
                        For t = 11 To n
                            b = wT.Range("A" & t).Value
                            ' Do we have an account?
                            If Left(b, 1) = "(" Then
                                ' Do we have a larger account?
                                If b > a Then
                                    ' Insert new row
                                    wT.Range("A" & t).EntireRow.Insert
                                    ' Insert account
                                    wT.Range("A" & t).Value = a
                                    ' Increment n
                                    n = n + 1
                                    ' Get out of the loop
                                    Exit For
                                End If
                            End If
                        Next t
                    End If
                End If
            Next s
        End If
    Next wT
    Application.ScreenUpdating = True
End Sub
See the attached version (now a .xlsm)

Sample Data.xlsm
You do not have the required permissions to view the files attached to this post.
Best wishes,
Hans

JDeMaro22
StarLounger
Posts: 94
Joined: 16 Oct 2021, 16:22

Re: Excel - Missing rows inquiry

Post by JDeMaro22 »

Thanks HansV you're amazing,

The only small error that occurs is for some odd reason it duplicates the expense "(54000) Salary Expense - employees" in each tab after sheet 3. I can remove each of these after sorting them its not a big issue but I'm curious as to why its happening.

Thanks so much,

Josh

JDeMaro22
StarLounger
Posts: 94
Joined: 16 Oct 2021, 16:22

Re: Excel - Missing rows inquiry

Post by JDeMaro22 »

Also i forgot to mention it runs in about 6 seconds, so that's also interesting

User avatar
HansV
Administrator
Posts: 78241
Joined: 16 Jan 2010, 00:14
Status: Microsoft MVP
Location: Wageningen, The Netherlands

Re: Excel - Missing rows inquiry

Post by HansV »

The reason is that the data begin in row 11 on the first few sheets, but on row 10 later on.
The number 11 occurs three times in the code. If you change all of them to 10, the problem should be solved.
Best wishes,
Hans

JDeMaro22
StarLounger
Posts: 94
Joined: 16 Oct 2021, 16:22

Re: Excel - Missing rows inquiry

Post by JDeMaro22 »

For some reason on all the other worksheets expense (50300) is missing and it adds this expense to all the other worksheets as that duplicate (54000) I tried deleting a row in the first 3 worksheets so that the data started on 10 but I'm still getting duplicates?

Thanks again

User avatar
HansV
Administrator
Posts: 78241
Joined: 16 Jan 2010, 00:14
Status: Microsoft MVP
Location: Wageningen, The Netherlands

Re: Excel - Missing rows inquiry

Post by HansV »

Here is the sample workbook with the proposed change. The macro appears to work correctly to me. Where does it go wrong in this version?

Sample Data.xlsm
You do not have the required permissions to view the files attached to this post.
Best wishes,
Hans

JDeMaro22
StarLounger
Posts: 94
Joined: 16 Oct 2021, 16:22

Re: Excel - Missing rows inquiry

Post by JDeMaro22 »

Whatever change you made right there seems to work great. Always a pleasure HansV, thank you.

JDeMaro22
StarLounger
Posts: 94
Joined: 16 Oct 2021, 16:22

Re: Excel - Missing rows inquiry

Post by JDeMaro22 »

Hi Hans,

Sorry to bother you but I cannot get that macro you wrote for me last month to work on this months file for the life of me. When I try to run it nothing happens not even a debug. Just to give you a recap you created it add additional rows that were missing on all other worksheets. I've attached a small sample of my new file this month. I cannot figure out why it doesn't work.

Thanks again,
Corp by site Nov 21 vs 20.xlsm
You do not have the required permissions to view the files attached to this post.

User avatar
HansV
Administrator
Posts: 78241
Joined: 16 Jan 2010, 00:14
Status: Microsoft MVP
Location: Wageningen, The Netherlands

Re: Excel - Missing rows inquiry

Post by HansV »

In your sample workbook, the accounts were in column A. In the new workbook, they are in column B, and column A is almost empty. Since the code doesn't find any accounts in column A, it skips to the end immediately.
Solution: change column A to column B throughout the code.
Also, you have added a sheet Table of Contents that has a different structure, so that has to be skipped (I assume).

Code: Select all

Sub AddRows()
    Dim wS As Worksheet
    Dim wT As Worksheet
    Dim s As Long
    Dim t As Long
    Dim m As Long
    Dim n As Long
    Dim a As String
    Dim b As String
    Dim c As Range
    Application.ScreenUpdating = False
    ' First sheet
    Set wS = Worksheets("CorpDepts Corporate Department")
    ' Get last used row
    m = wS.Range("B" & wS.Rows.Count).End(xlUp).Row
    ' Loop through the sheets
    For Each wT In Worksheets
        ' Skip the first one
        If wT.Name <> wS.Name And wT.Name <> "Table of Contents" Then
            ' Get last used row
            n = wT.Range("B" & wT.Rows.Count).End(xlUp).Row
            ' Loop through the rows of column A of the first sheet
            For s = 10 To m
                ' Get the cell value
                a = wS.Range("B" & s).Value
                ' Do we have an account?
                If Left(a, 1) = "(" Then
                    ' Can we find it in column A on the other sheet?
                    Set c = wT.Range("B10:B" & n).Find(What:=a, LookAt:=xlWhole)
                    ' If not
                    If c Is Nothing Then
                        ' Loop through the rows of column A
                        For t = 10 To n
                            b = wT.Range("B" & t).Value
                            ' Do we have an account?
                            If Left(b, 1) = "(" Then
                                ' Do we have a larger account?
                                If b > a Then
                                    ' Insert new row
                                    wT.Range("B" & t).EntireRow.Insert
                                    ' Insert account
                                    wT.Range("B" & t).Value = a
                                    ' Increment n
                                    n = n + 1
                                    ' Get out of the loop
                                    Exit For
                                End If
                            End If
                        Next t
                    End If
                End If
            Next s
        End If
    Next wT
    Application.ScreenUpdating = True
End Sub
Best wishes,
Hans

JDeMaro22
StarLounger
Posts: 94
Joined: 16 Oct 2021, 16:22

Re: Excel - Missing rows inquiry

Post by JDeMaro22 »

Hans I love you so much, you're my favorite person.

Thank you so much my friend,

Joshua

JDeMaro22
StarLounger
Posts: 94
Joined: 16 Oct 2021, 16:22

Re: Excel - Missing rows inquiry

Post by JDeMaro22 »

Also do you happen to have any suggestions how I could do a sort across all worksheets so that I can make them in numerical order as they are in the first worksheet "CorpDepts Corporate Department"? Most of the new rows the macro adds ends up at the bottom of the worksheet and I can't think of a way to make all the worksheets look the same without manually formatting each.

Thanks again