Database search and manipulation

lockarde

Board Regular
Joined
Oct 23, 2016
Messages
77
Good morning all,

I've hit a bit of a road block with some reporting and database automation and I was hoping one of you could help! I have a databse of product that I'm using to call certain data. For ease of reading the report I'd like to insert rows that have the summary of the product, then move on to the next product. Right now it's all manual, inserting rows, summing the cells above. For example:

SKUProduct Name1st qtr2nd qtr3rd qtr4th qtrSKUProduct Name1st qtr2nd qtr3rd qtr4th qtr
1234567891011Aloha T-Shirt (small, red)3132791234567891011Aloha T-Shirt (small, red)313279
1234567891012Aloha T-Shirt (medium, red)3132791234567891012Aloha T-Shirt (medium, red)313279
1234567891013Aloha T-Shirt (Large, red)3132791234567891013Aloha T-Shirt (Large, red)313279
1234567891014Aloha T-Shirt (Xlarge, red)3132791234567891014Aloha T-Shirt (Xlarge, red)313279
1234567891015Aloha T-Shirt (XXL, red)3132791234567891015Aloha T-Shirt (XXL, red)313279
1110987654312Rain Jacket (small, red)313279Aloha T-ShirtTotal156513545
1110987654313Rain Jacket (medium, red)313279To This ->
1110987654314Rain Jacket (Large, red)3132791110987654312Rain Jacket (small, red)313279
1110987654315Rain Jacket (Xlarge, red)3132791110987654313Rain Jacket (medium, red)313279
1110987654316Rain Jacket (XXL, red)3132791110987654314Rain Jacket (Large, red)313279
1110987654315Rain Jacket (Xlarge, red)313279
1110987654316Rain Jacket (XXL, red)313279
Rain JacketTotal156513545

<tbody>
</tbody>

I'm thinking it might be easiest to just have a set number of rows, regardless of the number of products, there might be empty rows, but it'd be easy to just "copy the SKUs here, every 15 ros, insert name, sum rows here". Normally this wouldn't be an issue, but the extra text (size,color) that is included in the product name column throws me off with a search and copy.

I appreciate any insight you guys might have!

lockarde
 

Excel Facts

Links? Where??
If Excel says you have links but you can't find them, go to Formulas, Name Manager. Look for old links to dead workbooks & delete.
Try:
Code:
Sub InsertRowsandSum()
    Application.ScreenUpdating = False
    Dim LastRow As Long, product As Range, rng As Range, val As String, RngList As Object, foundVal As Range, item As Variant, x As Long: x = 2
    Set RngList = CreateObject("Scripting.Dictionary")
    LastRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    Set rng = Range("B2:B" & LastRow)
    With CreateObject("Scripting.Dictionary")
        For Each product In rng
            val = Mid(product, 1, WorksheetFunction.Find("(", product, 1) - 2)
            If Not RngList.Exists(val) Then
                RngList.Add val, Nothing
            End If
        Next product
    End With
    For Each item In RngList
        Set foundVal = rng.Find(item, LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlPrevious, MatchCase:=False)
        Rows(foundVal.Row + 1).Insert
        Range("C" & foundVal.Row + 1).Formula = "=SUM(C" & x & ":C" & foundVal.Row & ")"
        Range("D" & foundVal.Row + 1).Formula = "=sum(D" & x & ":D" & foundVal.Row & ")"
        Range("E" & foundVal.Row + 1).Formula = "=sum(E" & x & ":E" & foundVal.Row & ")"
        Range("F" & foundVal.Row + 1).Formula = "=sum(F" & x & ":F" & foundVal.Row & ")"
        x = foundVal.Row + 2
    Next item
    RngList.RemoveAll
    Application.ScreenUpdating = True
End Sub
 
Upvote 0
Try:
Code:
Sub InsertRowsandSum()
    Application.ScreenUpdating = False
    Dim LastRow As Long, product As Range, rng As Range, val As String, RngList As Object, foundVal As Range, item As Variant, x As Long: x = 2
    Set RngList = CreateObject("Scripting.Dictionary")
    LastRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    Set rng = Range("B2:B" & LastRow)
    With CreateObject("Scripting.Dictionary")
        For Each product In rng
            val = Mid(product, 1, WorksheetFunction.Find("(", product, 1) - 2)
            If Not RngList.Exists(val) Then
                RngList.Add val, Nothing
            End If
        Next product
    End With
    For Each item In RngList
        Set foundVal = rng.Find(item, LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlPrevious, MatchCase:=False)
        Rows(foundVal.Row + 1).Insert
        Range("C" & foundVal.Row + 1).Formula = "=SUM(C" & x & ":C" & foundVal.Row & ")"
        Range("D" & foundVal.Row + 1).Formula = "=sum(D" & x & ":D" & foundVal.Row & ")"
        Range("E" & foundVal.Row + 1).Formula = "=sum(E" & x & ":E" & foundVal.Row & ")"
        Range("F" & foundVal.Row + 1).Formula = "=sum(F" & x & ":F" & foundVal.Row & ")"
        x = foundVal.Row + 2
    Next item
    RngList.RemoveAll
    Application.ScreenUpdating = True
End Sub

Thanks for your response mumps! I'll give this a try
 
Upvote 0
Try:
Code:
Sub InsertRowsandSum()
    Application.ScreenUpdating = False
    Dim LastRow As Long, product As Range, rng As Range, val As String, RngList As Object, foundVal As Range, item As Variant, x As Long: x = 2
    Set RngList = CreateObject("Scripting.Dictionary")
    LastRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    Set rng = Range("B2:B" & LastRow)
    With CreateObject("Scripting.Dictionary")
        For Each product In rng
            [COLOR=#b22222][B]val = Mid(product, 1, WorksheetFunction.Find("(", product, 1) - 2)[/B][/COLOR]
            If Not RngList.Exists(val) Then
                RngList.Add val, Nothing
            End If
        Next product
    End With
    For Each item In RngList
        Set foundVal = rng.Find(item, LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlPrevious, MatchCase:=False)
        Rows(foundVal.Row + 1).Insert
        Range("C" & foundVal.Row + 1).Formula = "=SUM(C" & x & ":C" & foundVal.Row & ")"
        Range("D" & foundVal.Row + 1).Formula = "=sum(D" & x & ":D" & foundVal.Row & ")"
        Range("E" & foundVal.Row + 1).Formula = "=sum(E" & x & ":E" & foundVal.Row & ")"
        Range("F" & foundVal.Row + 1).Formula = "=sum(F" & x & ":F" & foundVal.Row & ")"
        x = foundVal.Row + 2
    Next item
    RngList.RemoveAll
    Application.ScreenUpdating = True
End Sub

mumps, I'm running into an error "Unable to get the Find property of the WorksheetFunction class", debug sends me to the line I highlighted in red above. Any thoughts?
 
Upvote 0
Are there any product names that do not contain round brackets, for example: Aloha T-Shirt (small, red)
 
Upvote 0
Are there any product names that do not contain round brackets, for example: Aloha T-Shirt (small, red)

Nope, everything has round brackets at the end, though some have more than one set. For example, Aloha T-Shirt (small, black (8100)), not sure if that makes a difference though? I really appreciate your help with this!
 
Upvote 0
When I tested the macro on the data you posted, it worked without any errors. I think that it would be easier to help and test possible solutions if I could work with your actual file which includes any macros you are currently using. Perhaps you could upload a copy of your file to a free site such as www.box.com or www.dropbox.com. Once you do that, mark it for 'Sharing' and you will be given a link to the file that you can post here. If the workbook contains confidential information, you could replace it with generic data.
 
Upvote 0
Yea, I'm not sure why it isn't working, I am testing it in a fresh file with limited data as to not create any issues with the main report I'm putting together. Here is the test file that I'm using, it has limited data but once I get this macro working, scaling it up shouldn't be a problem.
 
Upvote 0
Replace this line of code:
Code:
Set rng = Range("B2:B" & LastRow)
with this line:
Code:
Set rng = Range("B3:B" & LastRow)
 
Upvote 0
Replace this line of code:
Code:
Set rng = Range("B2:B" & LastRow)
with this line:
Code:
Set rng = Range("B3:B" & LastRow)

Oooof. SMH - I skimmed right over that line last night, thanks! This is very close to what I'm looking for! Is there any way to add a check, (maybe with InStr?) so that the products are grouped together if they have the same base name? So all the Mats would be together, Climbing Mats, etc. I've updated the test file in Dropbox so you can see what I mean
 
Upvote 0

Forum statistics

Threads
1,213,535
Messages
6,114,198
Members
448,554
Latest member
Gleisner2

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top