Tech or Treat! Write an article about your scariest tech disaster to win gadgets!Learn more

x
?
Solved

Excel VBA Macro to insert rows based on criteria's being met

Posted on 2012-03-14
7
Medium Priority
?
427 Views
Last Modified: 2012-03-15
Hi Everyone,

I have a spreadsheet that has the following account numbers in two columns:

42002-080             52002-080
42002-080             52002-080
42002-100             52002-100
                                 52002-110
42003-950             52003-950
                                 52005-904
43001-023      
                                53006-000
                                53006-061


The 4XXXX series represent Revenue and the 5XXXX series represent COS.

I am trying to insert a row for the subtotal based on the change in value for the second character in either column.

i.e In the example above, I would insert a row in between 43001-023 and 52000-904 because the account number has the number 2 as its second character instead of the number 3.
0
Comment
Question by:jnsimex
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
7 Comments
 
LVL 93

Expert Comment

by:Patrick Matthews
ID: 37722249
You wrote:

i.e In the example above, I would insert a row in between 43001-023 and 52000-904 because the account number has the number 2 as its second character instead of the number 3.

Your sample data from the question has no entry for 52000-904.

Please post a sample file with sample input and the expected result given that sample input, along with a clearer description of what you are trying to do.
0
 

Author Comment

by:jnsimex
ID: 37722393
Sorry, I meant 52005-904

Basically, I am trying to creates ranges of account numbers that share the same 2nd character so I can subtotal them.

So all the 43xxx and 53xxxx accounts will be one range and all the 42xxx and 52xxx accounts will be anthor range etc.

Please see attached for the sample file
Book3.xlsx
0
 
LVL 10

Expert Comment

by:SANTABABY
ID: 37722539
Try using the following macro:

Sub InsertSubTotalRow()
Dim ContFlag As Boolean
Dim r As Long
Dim lastacc As String

    r = 1
    ContFlag = True
    lastacc = ""
   
    While ContFlag
        r = r + 1
        If Trim(Range("A" & r)) = "" And Trim(Range("B" & r)) = "" Then
            If Trim(Range("A" & r - 1)) = "" And Trim(Range("B" & r - 1)) = "" Then
                ContFlag = False
            Else
                lastacc = ""
            End If
        Else
            If Trim(Range("A" & r)) <> "" Then
                If lastacc <> "" And Trim(Left(Range("A" & r), 2)) <> lastacc Then
                    ActiveSheet.Rows(r).Insert Shift:=xlDown
                    lastacc = ""
                End If
                If lastacc = "" Then
                    lastacc = Left(Trim(Range("A" & r)), 2)
                End If
            End If
        End If
    Wend

End Sub
0
VIDEO: THE CONCERTO CLOUD FOR HEALTHCARE

Modern healthcare requires a modern cloud. View this brief video to understand how the Concerto Cloud for Healthcare can help your organization.

 
LVL 14

Expert Comment

by:Zack Barresse
ID: 37722629
Hmm, while I don't understand your data structure at all (can't give advice, as we don't know your intentions or purpose), this might get you what you're looking for...


Sub InsertRows()
    Dim iLastRow As Long
    Dim iRow As Long
    Dim iAcctInt As Long
    iLastRow = Range("A:B").Cells.Find(What:="*", After:=Range("A1"), LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    For iRow = iLastRow To 2 Step -1
        If Trim(Cells(iRow, 1).Value) <> vbNullString Then
            iAcctInt = Mid(Cells(iRow, 1).Value, 2, 1)
        End If
        If Trim(Cells(iRow, 2).Value) <> vbNullString Then
            If iAcctInt = 0 Then
                iAcctInt = Mid(Cells(iRow, 2).Value, 2, 1)
            End If
            If Mid(Cells(iRow, 2).Value, 2, 1) <> iAcctInt Then
                Rows(iRow + 1).Insert
                iAcctInt = 0
            End If
        End If
    Next iRow
End Sub


HTH

Regards,
Zack Barresse

Hiya Patrick!
0
 

Author Comment

by:jnsimex
ID: 37725299
@SantaBaby

When I run your macro on the full data, it works well but the insertion of the sub total row is off by 1 in a couple of ranges and dead on for other ranges.

I have uploaded the full data for you to see for yourself.
Book3.xlsx
0
 
LVL 14

Accepted Solution

by:
Zack Barresse earned 2000 total points
ID: 37725473
I see, your data isn't always constant and varies column to column whether it will have data or not.  In that case, maybe this will work for you instead...


Option Explicit

Sub InsertRows()
    Dim WS As Worksheet
    Dim rInsert As Range
    Dim iRow As Long
    Dim iLastRow As Long
    Application.ScreenUpdating = False
    Set WS = ActiveSheet 'change as desired
    WS.Columns(3).Insert
    iLastRow = WS.Range("A:B").Cells.Find(What:="*", After:=WS.Range("A1"), LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    Set rInsert = WS.Range("C1:C" & iLastRow)
    rInsert.NumberFormat = "General"
    rInsert.Formula = "=IF(TRIM(A1)="""",MID(TRIM(B1),2,1),MID(TRIM(A1),2,1))&""-""&IF(TRIM(B1)="""",MID(TRIM(A1),2,1),MID(TRIM(B1),2,1))"
    For iRow = iLastRow - 1 To 1 Step -1
        If WS.Cells(iRow, 3).Value <> WS.Cells(iRow + 1, 3).Value And WS.Cells(iRow + 1, 3).Value <> vbNullString Then
            Debug.Print iRow
            WS.Rows(iRow + 1).Insert
        End If
    Next iRow
    WS.Columns(3).Delete
    Application.ScreenUpdating = True
End Sub

Open in new window


HTH

Regards,
Zack Barresse
0
 

Author Closing Comment

by:jnsimex
ID: 37725507
Thank you Zack!..this macro worked like a champ
0

Featured Post

Free Tool: IP Lookup

Get more info about an IP address or domain name, such as organization, abuse contacts and geolocation.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Access developers frequently have requirements to interact with Excel (import from or output to) in their applications.  You might be able to accomplish this with the TransferSpreadsheet and OutputTo methods, but in this series of articles I will di…
In Part II of this series, I will discuss how to identify all open instances of Excel and enumerate the workbooks, spreadsheets, and named ranges within each of those instances.
The viewer will learn how to use a discrete random variable to simulate the return on an investment over a period of years, create a Monte Carlo simulation using the discrete random variable, and create a graph to represent the possible returns over…
Although Jacob Bernoulli (1654-1705) has been credited as the creator of "Binomial Distribution Table", Gottfried Leibniz (1646-1716) did his dissertation on the subject in 1666; Leibniz you may recall is the co-inventor of "Calculus" and beat Isaac…

647 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question